-- Generated code. {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE ForeignFunctionInterface, ConstraintKinds, TypeFamilies, MultiParamTypeClasses, KindSignatures, FlexibleInstances, UndecidableInstances, DataKinds, OverloadedStrings, NegativeLiterals, FlexibleContexts #-} module GI.GLib where import Prelude () import Data.GI.Base.ShortPrelude import Data.Char import Data.Int import Data.Word import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString) import qualified Data.Map as Map import Foreign.C import Foreign.Ptr import Foreign.ForeignPtr import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Storable (peek, poke, sizeOf) import Control.Applicative ((<$>)) import Control.Exception (onException) import Control.Monad.IO.Class import qualified Data.Text as T import Data.GI.Base.Attributes hiding (get, set) import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.Closure import Data.GI.Base.GError import Data.GI.Base.GHashTable import Data.GI.Base.GParamSpec import Data.GI.Base.GVariant import Data.GI.Base.GValue import Data.GI.Base.ManagedPtr import Data.GI.Base.Overloading import Data.GI.Base.Properties hiding (new) import Data.GI.Base.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId) import Data.GI.Base.Utils -- Flags AsciiType data AsciiType = AsciiTypeAlnum | AsciiTypeAlpha | AsciiTypeCntrl | AsciiTypeDigit | AsciiTypeGraph | AsciiTypeLower | AsciiTypePrint | AsciiTypePunct | AsciiTypeSpace | AsciiTypeUpper | AsciiTypeXdigit | AnotherAsciiType Int deriving (Show, Eq) instance Enum AsciiType where fromEnum AsciiTypeAlnum = 1 fromEnum AsciiTypeAlpha = 2 fromEnum AsciiTypeCntrl = 4 fromEnum AsciiTypeDigit = 8 fromEnum AsciiTypeGraph = 16 fromEnum AsciiTypeLower = 32 fromEnum AsciiTypePrint = 64 fromEnum AsciiTypePunct = 128 fromEnum AsciiTypeSpace = 256 fromEnum AsciiTypeUpper = 512 fromEnum AsciiTypeXdigit = 1024 fromEnum (AnotherAsciiType k) = k toEnum 1 = AsciiTypeAlnum toEnum 2 = AsciiTypeAlpha toEnum 4 = AsciiTypeCntrl toEnum 8 = AsciiTypeDigit toEnum 16 = AsciiTypeGraph toEnum 32 = AsciiTypeLower toEnum 64 = AsciiTypePrint toEnum 128 = AsciiTypePunct toEnum 256 = AsciiTypeSpace toEnum 512 = AsciiTypeUpper toEnum 1024 = AsciiTypeXdigit toEnum k = AnotherAsciiType k instance IsGFlag AsciiType -- struct AsyncQueue newtype AsyncQueue = AsyncQueue (ForeignPtr AsyncQueue) noAsyncQueue :: Maybe AsyncQueue noAsyncQueue = Nothing -- method AsyncQueue::length -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_async_queue_length" g_async_queue_length :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" IO Int32 asyncQueueLength :: (MonadIO m) => AsyncQueue -> -- _obj m Int32 asyncQueueLength _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_async_queue_length _obj' touchManagedPtr _obj return result -- method AsyncQueue::length_unlocked -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_async_queue_length_unlocked" g_async_queue_length_unlocked :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" IO Int32 asyncQueueLengthUnlocked :: (MonadIO m) => AsyncQueue -> -- _obj m Int32 asyncQueueLengthUnlocked _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_async_queue_length_unlocked _obj' touchManagedPtr _obj return result -- method AsyncQueue::lock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_queue_lock" g_async_queue_lock :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" IO () asyncQueueLock :: (MonadIO m) => AsyncQueue -> -- _obj m () asyncQueueLock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_async_queue_lock _obj' touchManagedPtr _obj return () -- method AsyncQueue::push -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_queue_push" g_async_queue_push :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" Ptr () -> -- data : TBasicType TVoid IO () asyncQueuePush :: (MonadIO m) => AsyncQueue -> -- _obj Ptr () -> -- data m () asyncQueuePush _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_async_queue_push _obj' data_ touchManagedPtr _obj return () -- method AsyncQueue::push_unlocked -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_queue_push_unlocked" g_async_queue_push_unlocked :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" Ptr () -> -- data : TBasicType TVoid IO () asyncQueuePushUnlocked :: (MonadIO m) => AsyncQueue -> -- _obj Ptr () -> -- data m () asyncQueuePushUnlocked _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_async_queue_push_unlocked _obj' data_ touchManagedPtr _obj return () -- method AsyncQueue::ref_unlocked -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_queue_ref_unlocked" g_async_queue_ref_unlocked :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" IO () {-# DEPRECATED asyncQueueRefUnlocked ["(Since version 2.8)","Reference counting is done atomically.","so g_async_queue_ref() can be used regardless of the @queue's","lock."]#-} asyncQueueRefUnlocked :: (MonadIO m) => AsyncQueue -> -- _obj m () asyncQueueRefUnlocked _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_async_queue_ref_unlocked _obj' touchManagedPtr _obj return () -- method AsyncQueue::unlock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_queue_unlock" g_async_queue_unlock :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" IO () asyncQueueUnlock :: (MonadIO m) => AsyncQueue -> -- _obj m () asyncQueueUnlock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_async_queue_unlock _obj' touchManagedPtr _obj return () -- method AsyncQueue::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_queue_unref" g_async_queue_unref :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" IO () asyncQueueUnref :: (MonadIO m) => AsyncQueue -> -- _obj m () asyncQueueUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_async_queue_unref _obj' touchManagedPtr _obj return () -- method AsyncQueue::unref_and_unlock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "AsyncQueue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_queue_unref_and_unlock" g_async_queue_unref_and_unlock :: Ptr AsyncQueue -> -- _obj : TInterface "GLib" "AsyncQueue" IO () {-# DEPRECATED asyncQueueUnrefAndUnlock ["(Since version 2.8)","Reference counting is done atomically.","so g_async_queue_unref() can be used regardless of the @queue's","lock."]#-} asyncQueueUnrefAndUnlock :: (MonadIO m) => AsyncQueue -> -- _obj m () asyncQueueUnrefAndUnlock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_async_queue_unref_and_unlock _obj' touchManagedPtr _obj return () -- struct BookmarkFile newtype BookmarkFile = BookmarkFile (ForeignPtr BookmarkFile) noBookmarkFile :: Maybe BookmarkFile noBookmarkFile = Nothing -- method BookmarkFile::add_application -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_add_application" g_bookmark_file_add_application :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- name : TBasicType TUTF8 CString -> -- exec : TBasicType TUTF8 IO () bookmarkFileAddApplication :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri Maybe (T.Text) -> -- name Maybe (T.Text) -> -- exec m () bookmarkFileAddApplication _obj uri name exec = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri maybeName <- case name of Nothing -> return nullPtr Just jName -> do jName' <- textToCString jName return jName' maybeExec <- case exec of Nothing -> return nullPtr Just jExec -> do jExec' <- textToCString jExec return jExec' g_bookmark_file_add_application _obj' uri' maybeName maybeExec touchManagedPtr _obj freeMem uri' freeMem maybeName freeMem maybeExec return () -- method BookmarkFile::add_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_add_group" g_bookmark_file_add_group :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- group : TBasicType TUTF8 IO () bookmarkFileAddGroup :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri T.Text -> -- group m () bookmarkFileAddGroup _obj uri group = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri group' <- textToCString group g_bookmark_file_add_group _obj' uri' group' touchManagedPtr _obj freeMem uri' freeMem group' return () -- method BookmarkFile::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_free" g_bookmark_file_free :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" IO () bookmarkFileFree :: (MonadIO m) => BookmarkFile -> -- _obj m () bookmarkFileFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_bookmark_file_free _obj' touchManagedPtr _obj return () -- method BookmarkFile::get_added -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_added" g_bookmark_file_get_added :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO Int64 bookmarkFileGetAdded :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m Int64 bookmarkFileGetAdded _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri onException (do result <- propagateGError $ g_bookmark_file_get_added _obj' uri' touchManagedPtr _obj freeMem uri' return result ) (do freeMem uri' ) -- method BookmarkFile::get_app_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exec", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "count", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "stamp", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_app_info" g_bookmark_file_get_app_info :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- name : TBasicType TUTF8 Ptr CString -> -- exec : TBasicType TUTF8 Ptr Word32 -> -- count : TBasicType TUInt32 Ptr Int64 -> -- stamp : TBasicType TInt64 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileGetAppInfo :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri T.Text -> -- name m (T.Text,Word32,Int64) bookmarkFileGetAppInfo _obj uri name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri name' <- textToCString name exec <- allocMem :: IO (Ptr CString) count <- allocMem :: IO (Ptr Word32) stamp <- allocMem :: IO (Ptr Int64) onException (do _ <- propagateGError $ g_bookmark_file_get_app_info _obj' uri' name' exec count stamp exec' <- peek exec exec'' <- cstringToText exec' freeMem exec' count' <- peek count stamp' <- peek stamp touchManagedPtr _obj freeMem uri' freeMem name' freeMem exec freeMem count freeMem stamp return (exec'', count', stamp') ) (do freeMem uri' freeMem name' freeMem exec freeMem count freeMem stamp ) -- method BookmarkFile::get_applications -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},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" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 2 (TBasicType TUTF8) -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_applications" g_bookmark_file_get_applications :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr CString) bookmarkFileGetApplications :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m [T.Text] bookmarkFileGetApplications _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_bookmark_file_get_applications _obj' uri' length_ length_' <- peek length_ result' <- (unpackUTF8CArrayWithLength length_') result (mapCArrayWithLength length_') freeMem result freeMem result touchManagedPtr _obj freeMem uri' freeMem length_ return result' ) (do freeMem uri' freeMem length_ ) -- method BookmarkFile::get_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_description" g_bookmark_file_get_description :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString bookmarkFileGetDescription :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m T.Text bookmarkFileGetDescription _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri onException (do result <- propagateGError $ g_bookmark_file_get_description _obj' uri' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem uri' return result' ) (do freeMem uri' ) -- method BookmarkFile::get_groups -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},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" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 2 (TBasicType TUTF8) -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_groups" g_bookmark_file_get_groups :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr CString) bookmarkFileGetGroups :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m [T.Text] bookmarkFileGetGroups _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_bookmark_file_get_groups _obj' uri' length_ length_' <- peek length_ result' <- (unpackUTF8CArrayWithLength length_') result (mapCArrayWithLength length_') freeMem result freeMem result touchManagedPtr _obj freeMem uri' freeMem length_ return result' ) (do freeMem uri' freeMem length_ ) -- method BookmarkFile::get_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "href", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_icon" g_bookmark_file_get_icon :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr CString -> -- href : TBasicType TUTF8 Ptr CString -> -- mime_type : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileGetIcon :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m (T.Text,T.Text) bookmarkFileGetIcon _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri href <- allocMem :: IO (Ptr CString) mime_type <- allocMem :: IO (Ptr CString) onException (do _ <- propagateGError $ g_bookmark_file_get_icon _obj' uri' href mime_type href' <- peek href href'' <- cstringToText href' freeMem href' mime_type' <- peek mime_type mime_type'' <- cstringToText mime_type' freeMem mime_type' touchManagedPtr _obj freeMem uri' freeMem href freeMem mime_type return (href'', mime_type'') ) (do freeMem uri' freeMem href freeMem mime_type ) -- method BookmarkFile::get_is_private -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_is_private" g_bookmark_file_get_is_private :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileGetIsPrivate :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m () bookmarkFileGetIsPrivate _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri onException (do _ <- propagateGError $ g_bookmark_file_get_is_private _obj' uri' touchManagedPtr _obj freeMem uri' return () ) (do freeMem uri' ) -- method BookmarkFile::get_mime_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_mime_type" g_bookmark_file_get_mime_type :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString bookmarkFileGetMimeType :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m T.Text bookmarkFileGetMimeType _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri onException (do result <- propagateGError $ g_bookmark_file_get_mime_type _obj' uri' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem uri' return result' ) (do freeMem uri' ) -- method BookmarkFile::get_modified -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_modified" g_bookmark_file_get_modified :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO Int64 bookmarkFileGetModified :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m Int64 bookmarkFileGetModified _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri onException (do result <- propagateGError $ g_bookmark_file_get_modified _obj' uri' touchManagedPtr _obj freeMem uri' return result ) (do freeMem uri' ) -- method BookmarkFile::get_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_get_size" g_bookmark_file_get_size :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" IO Int32 bookmarkFileGetSize :: (MonadIO m) => BookmarkFile -> -- _obj m Int32 bookmarkFileGetSize _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_bookmark_file_get_size _obj' touchManagedPtr _obj return result -- method BookmarkFile::get_title -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_title" g_bookmark_file_get_title :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString bookmarkFileGetTitle :: (MonadIO m) => BookmarkFile -> -- _obj Maybe (T.Text) -> -- uri m T.Text bookmarkFileGetTitle _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeUri <- case uri of Nothing -> return nullPtr Just jUri -> do jUri' <- textToCString jUri return jUri' onException (do result <- propagateGError $ g_bookmark_file_get_title _obj' maybeUri result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem maybeUri return result' ) (do freeMem maybeUri ) -- method BookmarkFile::get_uris -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},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" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_get_uris" g_bookmark_file_get_uris :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" Ptr Word64 -> -- length : TBasicType TUInt64 IO (Ptr CString) bookmarkFileGetUris :: (MonadIO m) => BookmarkFile -> -- _obj m [T.Text] bookmarkFileGetUris _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj length_ <- allocMem :: IO (Ptr Word64) result <- g_bookmark_file_get_uris _obj' length_ length_' <- peek length_ result' <- (unpackUTF8CArrayWithLength length_') result (mapCArrayWithLength length_') freeMem result freeMem result touchManagedPtr _obj freeMem length_ return result' -- method BookmarkFile::get_visited -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_get_visited" g_bookmark_file_get_visited :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO Int64 bookmarkFileGetVisited :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m Int64 bookmarkFileGetVisited _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri onException (do result <- propagateGError $ g_bookmark_file_get_visited _obj' uri' touchManagedPtr _obj freeMem uri' return result ) (do freeMem uri' ) -- method BookmarkFile::has_application -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_has_application" g_bookmark_file_has_application :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- name : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileHasApplication :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri T.Text -> -- name m () bookmarkFileHasApplication _obj uri name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri name' <- textToCString name onException (do _ <- propagateGError $ g_bookmark_file_has_application _obj' uri' name' touchManagedPtr _obj freeMem uri' freeMem name' return () ) (do freeMem uri' freeMem name' ) -- method BookmarkFile::has_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_has_group" g_bookmark_file_has_group :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- group : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileHasGroup :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri T.Text -> -- group m () bookmarkFileHasGroup _obj uri group = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri group' <- textToCString group onException (do _ <- propagateGError $ g_bookmark_file_has_group _obj' uri' group' touchManagedPtr _obj freeMem uri' freeMem group' return () ) (do freeMem uri' freeMem group' ) -- method BookmarkFile::has_item -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_has_item" g_bookmark_file_has_item :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 IO CInt bookmarkFileHasItem :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m Bool bookmarkFileHasItem _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri result <- g_bookmark_file_has_item _obj' uri' let result' = (/= 0) result touchManagedPtr _obj freeMem uri' return result' -- method BookmarkFile::load_from_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_load_from_data" g_bookmark_file_load_from_data :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- data : TBasicType TUTF8 Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileLoadFromData :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- data Word64 -> -- length m () bookmarkFileLoadFromData _obj data_ length_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj data_' <- textToCString data_ onException (do _ <- propagateGError $ g_bookmark_file_load_from_data _obj' data_' length_ touchManagedPtr _obj freeMem data_' return () ) (do freeMem data_' ) -- method BookmarkFile::load_from_data_dirs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "full_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "full_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_load_from_data_dirs" g_bookmark_file_load_from_data_dirs :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- file : TBasicType TUTF8 CString -> -- full_path : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileLoadFromDataDirs :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- file Maybe (T.Text) -> -- full_path m () bookmarkFileLoadFromDataDirs _obj file full_path = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj file' <- textToCString file maybeFull_path <- case full_path of Nothing -> return nullPtr Just jFull_path -> do jFull_path' <- textToCString jFull_path return jFull_path' onException (do _ <- propagateGError $ g_bookmark_file_load_from_data_dirs _obj' file' maybeFull_path touchManagedPtr _obj freeMem file' freeMem maybeFull_path return () ) (do freeMem file' freeMem maybeFull_path ) -- method BookmarkFile::load_from_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_load_from_file" g_bookmark_file_load_from_file :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- filename : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileLoadFromFile :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- filename m () bookmarkFileLoadFromFile _obj filename = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj filename' <- textToCString filename onException (do _ <- propagateGError $ g_bookmark_file_load_from_file _obj' filename' touchManagedPtr _obj freeMem filename' return () ) (do freeMem filename' ) -- method BookmarkFile::move_item -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_move_item" g_bookmark_file_move_item :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- old_uri : TBasicType TUTF8 CString -> -- new_uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileMoveItem :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- old_uri Maybe (T.Text) -> -- new_uri m () bookmarkFileMoveItem _obj old_uri new_uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj old_uri' <- textToCString old_uri maybeNew_uri <- case new_uri of Nothing -> return nullPtr Just jNew_uri -> do jNew_uri' <- textToCString jNew_uri return jNew_uri' onException (do _ <- propagateGError $ g_bookmark_file_move_item _obj' old_uri' maybeNew_uri touchManagedPtr _obj freeMem old_uri' freeMem maybeNew_uri return () ) (do freeMem old_uri' freeMem maybeNew_uri ) -- method BookmarkFile::remove_application -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_remove_application" g_bookmark_file_remove_application :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- name : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileRemoveApplication :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri T.Text -> -- name m () bookmarkFileRemoveApplication _obj uri name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri name' <- textToCString name onException (do _ <- propagateGError $ g_bookmark_file_remove_application _obj' uri' name' touchManagedPtr _obj freeMem uri' freeMem name' return () ) (do freeMem uri' freeMem name' ) -- method BookmarkFile::remove_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_remove_group" g_bookmark_file_remove_group :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- group : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileRemoveGroup :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri T.Text -> -- group m () bookmarkFileRemoveGroup _obj uri group = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri group' <- textToCString group onException (do _ <- propagateGError $ g_bookmark_file_remove_group _obj' uri' group' touchManagedPtr _obj freeMem uri' freeMem group' return () ) (do freeMem uri' freeMem group' ) -- method BookmarkFile::remove_item -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_remove_item" g_bookmark_file_remove_item :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileRemoveItem :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri m () bookmarkFileRemoveItem _obj uri = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri onException (do _ <- propagateGError $ g_bookmark_file_remove_item _obj' uri' touchManagedPtr _obj freeMem uri' return () ) (do freeMem uri' ) -- method BookmarkFile::set_added -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "added", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "added", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_set_added" g_bookmark_file_set_added :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Int64 -> -- added : TBasicType TInt64 IO () bookmarkFileSetAdded :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri Int64 -> -- added m () bookmarkFileSetAdded _obj uri added = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri g_bookmark_file_set_added _obj' uri' added touchManagedPtr _obj freeMem uri' return () -- method BookmarkFile::set_app_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stamp", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stamp", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_set_app_info" g_bookmark_file_set_app_info :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- name : TBasicType TUTF8 CString -> -- exec : TBasicType TUTF8 Int32 -> -- count : TBasicType TInt32 Int64 -> -- stamp : TBasicType TInt64 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileSetAppInfo :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri T.Text -> -- name T.Text -> -- exec Int32 -> -- count Int64 -> -- stamp m () bookmarkFileSetAppInfo _obj uri name exec count stamp = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri name' <- textToCString name exec' <- textToCString exec onException (do _ <- propagateGError $ g_bookmark_file_set_app_info _obj' uri' name' exec' count stamp touchManagedPtr _obj freeMem uri' freeMem name' freeMem exec' return () ) (do freeMem uri' freeMem name' freeMem exec' ) -- method BookmarkFile::set_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_set_description" g_bookmark_file_set_description :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- description : TBasicType TUTF8 IO () bookmarkFileSetDescription :: (MonadIO m) => BookmarkFile -> -- _obj Maybe (T.Text) -> -- uri T.Text -> -- description m () bookmarkFileSetDescription _obj uri description = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeUri <- case uri of Nothing -> return nullPtr Just jUri -> do jUri' <- textToCString jUri return jUri' description' <- textToCString description g_bookmark_file_set_description _obj' maybeUri description' touchManagedPtr _obj freeMem maybeUri freeMem description' return () -- method BookmarkFile::set_groups -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "groups", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "groups", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", 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_bookmark_file_set_groups" g_bookmark_file_set_groups :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- groups : TBasicType TUTF8 Word64 -> -- length : TBasicType TUInt64 IO () bookmarkFileSetGroups :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri Maybe (T.Text) -> -- groups Word64 -> -- length m () bookmarkFileSetGroups _obj uri groups length_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri maybeGroups <- case groups of Nothing -> return nullPtr Just jGroups -> do jGroups' <- textToCString jGroups return jGroups' g_bookmark_file_set_groups _obj' uri' maybeGroups length_ touchManagedPtr _obj freeMem uri' freeMem maybeGroups return () -- method BookmarkFile::set_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "href", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "href", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_set_icon" g_bookmark_file_set_icon :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- href : TBasicType TUTF8 CString -> -- mime_type : TBasicType TUTF8 IO () bookmarkFileSetIcon :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri Maybe (T.Text) -> -- href T.Text -> -- mime_type m () bookmarkFileSetIcon _obj uri href mime_type = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri maybeHref <- case href of Nothing -> return nullPtr Just jHref -> do jHref' <- textToCString jHref return jHref' mime_type' <- textToCString mime_type g_bookmark_file_set_icon _obj' uri' maybeHref mime_type' touchManagedPtr _obj freeMem uri' freeMem maybeHref freeMem mime_type' return () -- method BookmarkFile::set_is_private -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_private", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_private", 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_bookmark_file_set_is_private" g_bookmark_file_set_is_private :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CInt -> -- is_private : TBasicType TBoolean IO () bookmarkFileSetIsPrivate :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri Bool -> -- is_private m () bookmarkFileSetIsPrivate _obj uri is_private = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri let is_private' = (fromIntegral . fromEnum) is_private g_bookmark_file_set_is_private _obj' uri' is_private' touchManagedPtr _obj freeMem uri' return () -- method BookmarkFile::set_mime_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_set_mime_type" g_bookmark_file_set_mime_type :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- mime_type : TBasicType TUTF8 IO () bookmarkFileSetMimeType :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri T.Text -> -- mime_type m () bookmarkFileSetMimeType _obj uri mime_type = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri mime_type' <- textToCString mime_type g_bookmark_file_set_mime_type _obj' uri' mime_type' touchManagedPtr _obj freeMem uri' freeMem mime_type' return () -- method BookmarkFile::set_modified -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "modified", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "modified", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_set_modified" g_bookmark_file_set_modified :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Int64 -> -- modified : TBasicType TInt64 IO () bookmarkFileSetModified :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri Int64 -> -- modified m () bookmarkFileSetModified _obj uri modified = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri g_bookmark_file_set_modified _obj' uri' modified touchManagedPtr _obj freeMem uri' return () -- method BookmarkFile::set_title -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "title", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "title", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_set_title" g_bookmark_file_set_title :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 CString -> -- title : TBasicType TUTF8 IO () bookmarkFileSetTitle :: (MonadIO m) => BookmarkFile -> -- _obj Maybe (T.Text) -> -- uri T.Text -> -- title m () bookmarkFileSetTitle _obj uri title = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeUri <- case uri of Nothing -> return nullPtr Just jUri -> do jUri' <- textToCString jUri return jUri' title' <- textToCString title g_bookmark_file_set_title _obj' maybeUri title' touchManagedPtr _obj freeMem maybeUri freeMem title' return () -- method BookmarkFile::set_visited -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "visited", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "visited", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_set_visited" g_bookmark_file_set_visited :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- uri : TBasicType TUTF8 Int64 -> -- visited : TBasicType TInt64 IO () bookmarkFileSetVisited :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- uri Int64 -> -- visited m () bookmarkFileSetVisited _obj uri visited = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj uri' <- textToCString uri g_bookmark_file_set_visited _obj' uri' visited touchManagedPtr _obj freeMem uri' return () -- method BookmarkFile::to_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_to_data" g_bookmark_file_to_data :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString bookmarkFileToData :: (MonadIO m) => BookmarkFile -> -- _obj m (T.Text,Word64) bookmarkFileToData _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_bookmark_file_to_data _obj' length_ result' <- cstringToText result freeMem result length_' <- peek length_ touchManagedPtr _obj freeMem length_ return (result', length_') ) (do freeMem length_ ) -- method BookmarkFile::to_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "BookmarkFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_bookmark_file_to_file" g_bookmark_file_to_file :: Ptr BookmarkFile -> -- _obj : TInterface "GLib" "BookmarkFile" CString -> -- filename : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt bookmarkFileToFile :: (MonadIO m) => BookmarkFile -> -- _obj T.Text -> -- filename m () bookmarkFileToFile _obj filename = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj filename' <- textToCString filename onException (do _ <- propagateGError $ g_bookmark_file_to_file _obj' filename' touchManagedPtr _obj freeMem filename' return () ) (do freeMem filename' ) -- Enum BookmarkFileError data BookmarkFileError = BookmarkFileErrorInvalidUri | BookmarkFileErrorInvalidValue | BookmarkFileErrorAppNotRegistered | BookmarkFileErrorUriNotFound | BookmarkFileErrorRead | BookmarkFileErrorUnknownEncoding | BookmarkFileErrorWrite | BookmarkFileErrorFileNotFound | AnotherBookmarkFileError Int deriving (Show, Eq) instance Enum BookmarkFileError where fromEnum BookmarkFileErrorInvalidUri = 0 fromEnum BookmarkFileErrorInvalidValue = 1 fromEnum BookmarkFileErrorAppNotRegistered = 2 fromEnum BookmarkFileErrorUriNotFound = 3 fromEnum BookmarkFileErrorRead = 4 fromEnum BookmarkFileErrorUnknownEncoding = 5 fromEnum BookmarkFileErrorWrite = 6 fromEnum BookmarkFileErrorFileNotFound = 7 fromEnum (AnotherBookmarkFileError k) = k toEnum 0 = BookmarkFileErrorInvalidUri toEnum 1 = BookmarkFileErrorInvalidValue toEnum 2 = BookmarkFileErrorAppNotRegistered toEnum 3 = BookmarkFileErrorUriNotFound toEnum 4 = BookmarkFileErrorRead toEnum 5 = BookmarkFileErrorUnknownEncoding toEnum 6 = BookmarkFileErrorWrite toEnum 7 = BookmarkFileErrorFileNotFound toEnum k = AnotherBookmarkFileError k instance GErrorClass BookmarkFileError where gerrorClassDomain _ = "g-bookmark-file-error-quark" catchBookmarkFileError :: IO a -> (BookmarkFileError -> GErrorMessage -> IO a) -> IO a catchBookmarkFileError = catchGErrorJustDomain handleBookmarkFileError :: (BookmarkFileError -> GErrorMessage -> IO a) -> IO a -> IO a handleBookmarkFileError = handleGErrorJustDomain -- struct ByteArray newtype ByteArray = ByteArray (ForeignPtr ByteArray) noByteArray :: Maybe ByteArray noByteArray = Nothing foreign import ccall "g_byte_array_get_type" c_g_byte_array_get_type :: IO GType instance BoxedObject ByteArray where boxedType _ = c_g_byte_array_get_type byteArrayReadData :: ByteArray -> IO Word8 byteArrayReadData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word8 return val byteArrayReadLen :: ByteArray -> IO Word32 byteArrayReadLen s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val -- struct Bytes newtype Bytes = Bytes (ForeignPtr Bytes) noBytes :: Maybe Bytes noBytes = Nothing foreign import ccall "g_bytes_get_type" c_g_bytes_get_type :: IO GType instance BoxedObject Bytes where boxedType _ = c_g_bytes_get_type -- method Bytes::new -- method type : Constructor -- Args : [Arg {argName = "data", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = True, 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 : [Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "data", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : False -- Skip return : False foreign import ccall "g_bytes_new" g_bytes_new :: Ptr Word8 -> -- data : TCArray False (-1) 1 (TBasicType TUInt8) Word64 -> -- size : TBasicType TUInt64 IO (Ptr Bytes) bytesNew :: (MonadIO m) => Maybe (ByteString) -> -- data m Bytes bytesNew data_ = liftIO $ do let size = case data_ of Nothing -> 0 Just jData_ -> fromIntegral $ B.length jData_ maybeData_ <- case data_ of Nothing -> return nullPtr Just jData_ -> do jData_' <- packByteString jData_ return jData_' result <- g_bytes_new maybeData_ size result' <- (wrapBoxed Bytes) result freeMem maybeData_ return result' -- method Bytes::new_take -- method type : Constructor -- Args : [Arg {argName = "data", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "data", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TInterface "GLib" "Bytes" -- throws : False -- Skip return : False foreign import ccall "g_bytes_new_take" g_bytes_new_take :: Ptr Word8 -> -- data : TCArray False (-1) 1 (TBasicType TUInt8) Word64 -> -- size : TBasicType TUInt64 IO (Ptr Bytes) bytesNewTake :: (MonadIO m) => Maybe (ByteString) -> -- data m Bytes bytesNewTake data_ = liftIO $ do let size = case data_ of Nothing -> 0 Just jData_ -> fromIntegral $ B.length jData_ maybeData_ <- case data_ of Nothing -> return nullPtr Just jData_ -> do jData_' <- packByteString jData_ return jData_' result <- g_bytes_new_take maybeData_ size result' <- (wrapBoxed Bytes) result return result' -- method Bytes::compare -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes2", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes2", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_bytes_compare" g_bytes_compare :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" Ptr Bytes -> -- bytes2 : TInterface "GLib" "Bytes" IO Int32 bytesCompare :: (MonadIO m) => Bytes -> -- _obj Bytes -> -- bytes2 m Int32 bytesCompare _obj bytes2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let bytes2' = unsafeManagedPtrGetPtr bytes2 result <- g_bytes_compare _obj' bytes2' touchManagedPtr _obj touchManagedPtr bytes2 return result -- method Bytes::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes2", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes2", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_bytes_equal" g_bytes_equal :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" Ptr Bytes -> -- bytes2 : TInterface "GLib" "Bytes" IO CInt bytesEqual :: (MonadIO m) => Bytes -> -- _obj Bytes -> -- bytes2 m Bool bytesEqual _obj bytes2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let bytes2' = unsafeManagedPtrGetPtr bytes2 result <- g_bytes_equal _obj' bytes2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr bytes2 return result' -- method Bytes::get_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TUInt8) -- throws : False -- Skip return : False foreign import ccall "g_bytes_get_data" g_bytes_get_data :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" Ptr Word64 -> -- size : TBasicType TUInt64 IO (Ptr Word8) bytesGetData :: (MonadIO m) => Bytes -> -- _obj m ByteString bytesGetData _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj size <- allocMem :: IO (Ptr Word64) result <- g_bytes_get_data _obj' size size' <- peek size result' <- (unpackByteStringWithLength size') result touchManagedPtr _obj freeMem size return result' -- method Bytes::get_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_bytes_get_size" g_bytes_get_size :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" IO Word64 bytesGetSize :: (MonadIO m) => Bytes -> -- _obj m Word64 bytesGetSize _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_bytes_get_size _obj' touchManagedPtr _obj return result -- method Bytes::hash -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_bytes_hash" g_bytes_hash :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" IO Word32 bytesHash :: (MonadIO m) => Bytes -> -- _obj m Word32 bytesHash _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_bytes_hash _obj' touchManagedPtr _obj return result -- method Bytes::new_from_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "offset", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : False -- Skip return : False foreign import ccall "g_bytes_new_from_bytes" g_bytes_new_from_bytes :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" Word64 -> -- offset : TBasicType TUInt64 Word64 -> -- length : TBasicType TUInt64 IO (Ptr Bytes) bytesNewFromBytes :: (MonadIO m) => Bytes -> -- _obj Word64 -> -- offset Word64 -> -- length m Bytes bytesNewFromBytes _obj offset length_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_bytes_new_from_bytes _obj' offset length_ result' <- (wrapBoxed Bytes) result touchManagedPtr _obj return result' -- method Bytes::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : False -- Skip return : False foreign import ccall "g_bytes_ref" g_bytes_ref :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" IO (Ptr Bytes) bytesRef :: (MonadIO m) => Bytes -> -- _obj m Bytes bytesRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_bytes_ref _obj' result' <- (wrapBoxed Bytes) result touchManagedPtr _obj return result' -- method Bytes::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bytes_unref" g_bytes_unref :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" IO () bytesUnref :: (MonadIO m) => Bytes -> -- _obj m () bytesUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_bytes_unref _obj' touchManagedPtr _obj return () -- method Bytes::unref_to_array -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TByteArray -- throws : False -- Skip return : False foreign import ccall "g_bytes_unref_to_array" g_bytes_unref_to_array :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" IO (Ptr GByteArray) bytesUnrefToArray :: (MonadIO m) => Bytes -> -- _obj m ByteString bytesUnrefToArray _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_bytes_unref_to_array _obj' result' <- unpackGByteArray result unrefGByteArray result touchManagedPtr _obj return result' -- method Bytes::unref_to_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Bytes", 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" "Bytes", 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_bytes_unref_to_data" g_bytes_unref_to_data :: Ptr Bytes -> -- _obj : TInterface "GLib" "Bytes" Word64 -> -- size : TBasicType TUInt64 IO () bytesUnrefToData :: (MonadIO m) => Bytes -> -- _obj Word64 -> -- size m () bytesUnrefToData _obj size = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_bytes_unref_to_data _obj' size touchManagedPtr _obj return () -- struct Checksum newtype Checksum = Checksum (ForeignPtr Checksum) noChecksum :: Maybe Checksum noChecksum = Nothing foreign import ccall "g_checksum_get_type" c_g_checksum_get_type :: IO GType instance BoxedObject Checksum where boxedType _ = c_g_checksum_get_type -- method Checksum::new -- method type : Constructor -- Args : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Checksum" -- throws : False -- Skip return : False foreign import ccall "g_checksum_new" g_checksum_new :: CUInt -> -- checksum_type : TInterface "GLib" "ChecksumType" IO (Ptr Checksum) checksumNew :: (MonadIO m) => ChecksumType -> -- checksum_type m Checksum checksumNew checksum_type = liftIO $ do let checksum_type' = (fromIntegral . fromEnum) checksum_type result <- g_checksum_new checksum_type' result' <- (wrapBoxed Checksum) result return result' -- method Checksum::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Checksum" -- throws : False -- Skip return : False foreign import ccall "g_checksum_copy" g_checksum_copy :: Ptr Checksum -> -- _obj : TInterface "GLib" "Checksum" IO (Ptr Checksum) checksumCopy :: (MonadIO m) => Checksum -> -- _obj m Checksum checksumCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_checksum_copy _obj' result' <- (wrapBoxed Checksum) result touchManagedPtr _obj return result' -- method Checksum::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_checksum_free" g_checksum_free :: Ptr Checksum -> -- _obj : TInterface "GLib" "Checksum" IO () checksumFree :: (MonadIO m) => Checksum -> -- _obj m () checksumFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_checksum_free _obj' touchManagedPtr _obj return () -- method Checksum::get_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_checksum_get_string" g_checksum_get_string :: Ptr Checksum -> -- _obj : TInterface "GLib" "Checksum" IO CString checksumGetString :: (MonadIO m) => Checksum -> -- _obj m T.Text checksumGetString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_checksum_get_string _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method Checksum::reset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_checksum_reset" g_checksum_reset :: Ptr Checksum -> -- _obj : TInterface "GLib" "Checksum" IO () checksumReset :: (MonadIO m) => Checksum -> -- _obj m () checksumReset _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_checksum_reset _obj' touchManagedPtr _obj return () -- method Checksum::update -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Checksum", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_checksum_update" g_checksum_update :: Ptr Checksum -> -- _obj : TInterface "GLib" "Checksum" Ptr Word8 -> -- data : TCArray False (-1) 2 (TBasicType TUInt8) Int64 -> -- length : TBasicType TInt64 IO () checksumUpdate :: (MonadIO m) => Checksum -> -- _obj ByteString -> -- data m () checksumUpdate _obj data_ = liftIO $ do let length_ = fromIntegral $ B.length data_ let _obj' = unsafeManagedPtrGetPtr _obj data_' <- packByteString data_ g_checksum_update _obj' data_' length_ touchManagedPtr _obj freeMem data_' return () -- Enum ChecksumType data ChecksumType = ChecksumTypeMd5 | ChecksumTypeSha1 | ChecksumTypeSha256 | ChecksumTypeSha512 | AnotherChecksumType Int deriving (Show, Eq) instance Enum ChecksumType where fromEnum ChecksumTypeMd5 = 0 fromEnum ChecksumTypeSha1 = 1 fromEnum ChecksumTypeSha256 = 2 fromEnum ChecksumTypeSha512 = 3 fromEnum (AnotherChecksumType k) = k toEnum 0 = ChecksumTypeMd5 toEnum 1 = ChecksumTypeSha1 toEnum 2 = ChecksumTypeSha256 toEnum 3 = ChecksumTypeSha512 toEnum k = AnotherChecksumType k -- callback ChildWatchFunc childWatchFuncClosure :: ChildWatchFunc -> IO Closure childWatchFuncClosure cb = newCClosure =<< mkChildWatchFunc wrapped where wrapped = childWatchFuncWrapper Nothing cb type ChildWatchFuncC = Int32 -> Int32 -> Ptr () -> IO () foreign import ccall "wrapper" mkChildWatchFunc :: ChildWatchFuncC -> IO (FunPtr ChildWatchFuncC) type ChildWatchFunc = Int32 -> Int32 -> IO () noChildWatchFunc :: Maybe ChildWatchFunc noChildWatchFunc = Nothing childWatchFuncWrapper :: Maybe (Ptr (FunPtr (ChildWatchFuncC))) -> ChildWatchFunc -> Int32 -> Int32 -> Ptr () -> IO () childWatchFuncWrapper funptrptr _cb pid status _ = do _cb pid status maybeReleaseFunPtr funptrptr -- callback CompareDataFunc compareDataFuncClosure :: CompareDataFunc -> IO Closure compareDataFuncClosure cb = newCClosure =<< mkCompareDataFunc wrapped where wrapped = compareDataFuncWrapper Nothing cb type CompareDataFuncC = Ptr () -> Ptr () -> Ptr () -> IO Int32 foreign import ccall "wrapper" mkCompareDataFunc :: CompareDataFuncC -> IO (FunPtr CompareDataFuncC) type CompareDataFunc = Ptr () -> Ptr () -> IO Int32 noCompareDataFunc :: Maybe CompareDataFunc noCompareDataFunc = Nothing compareDataFuncWrapper :: Maybe (Ptr (FunPtr (CompareDataFuncC))) -> CompareDataFunc -> Ptr () -> Ptr () -> Ptr () -> IO Int32 compareDataFuncWrapper funptrptr _cb a b _ = do result <- _cb a b maybeReleaseFunPtr funptrptr return result -- callback CompareFunc compareFuncClosure :: CompareFunc -> IO Closure compareFuncClosure cb = newCClosure =<< mkCompareFunc wrapped where wrapped = compareFuncWrapper Nothing cb type CompareFuncC = Ptr () -> Ptr () -> IO Int32 foreign import ccall "wrapper" mkCompareFunc :: CompareFuncC -> IO (FunPtr CompareFuncC) type CompareFunc = Ptr () -> Ptr () -> IO Int32 noCompareFunc :: Maybe CompareFunc noCompareFunc = Nothing compareFuncWrapper :: Maybe (Ptr (FunPtr (CompareFuncC))) -> CompareFunc -> Ptr () -> Ptr () -> IO Int32 compareFuncWrapper funptrptr _cb a b = do result <- _cb a b maybeReleaseFunPtr funptrptr return result -- struct Cond newtype Cond = Cond (ForeignPtr Cond) noCond :: Maybe Cond noCond = Nothing -- method Cond::broadcast -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cond_broadcast" g_cond_broadcast :: Ptr Cond -> -- _obj : TInterface "GLib" "Cond" IO () condBroadcast :: (MonadIO m) => Cond -> -- _obj m () condBroadcast _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_cond_broadcast _obj' touchManagedPtr _obj return () -- method Cond::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cond_clear" g_cond_clear :: Ptr Cond -> -- _obj : TInterface "GLib" "Cond" IO () condClear :: (MonadIO m) => Cond -> -- _obj m () condClear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_cond_clear _obj' touchManagedPtr _obj return () -- method Cond::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cond_init" g_cond_init :: Ptr Cond -> -- _obj : TInterface "GLib" "Cond" IO () condInit :: (MonadIO m) => Cond -> -- _obj m () condInit _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_cond_init _obj' touchManagedPtr _obj return () -- method Cond::signal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cond_signal" g_cond_signal :: Ptr Cond -> -- _obj : TInterface "GLib" "Cond" IO () condSignal :: (MonadIO m) => Cond -> -- _obj m () condSignal _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_cond_signal _obj' touchManagedPtr _obj return () -- method Cond::wait -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mutex", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mutex", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cond_wait" g_cond_wait :: Ptr Cond -> -- _obj : TInterface "GLib" "Cond" Ptr Mutex -> -- mutex : TInterface "GLib" "Mutex" IO () condWait :: (MonadIO m) => Cond -> -- _obj Mutex -> -- mutex m () condWait _obj mutex = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let mutex' = unsafeManagedPtrGetPtr mutex g_cond_wait _obj' mutex' touchManagedPtr _obj touchManagedPtr mutex return () -- method Cond::wait_until -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mutex", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_time", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mutex", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_time", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_cond_wait_until" g_cond_wait_until :: Ptr Cond -> -- _obj : TInterface "GLib" "Cond" Ptr Mutex -> -- mutex : TInterface "GLib" "Mutex" Int64 -> -- end_time : TBasicType TInt64 IO CInt condWaitUntil :: (MonadIO m) => Cond -> -- _obj Mutex -> -- mutex Int64 -> -- end_time m Bool condWaitUntil _obj mutex end_time = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let mutex' = unsafeManagedPtrGetPtr mutex result <- g_cond_wait_until _obj' mutex' end_time let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr mutex return result' -- Enum ConvertError data ConvertError = ConvertErrorNoConversion | ConvertErrorIllegalSequence | ConvertErrorFailed | ConvertErrorPartialInput | ConvertErrorBadUri | ConvertErrorNotAbsolutePath | ConvertErrorNoMemory | AnotherConvertError Int deriving (Show, Eq) instance Enum ConvertError where fromEnum ConvertErrorNoConversion = 0 fromEnum ConvertErrorIllegalSequence = 1 fromEnum ConvertErrorFailed = 2 fromEnum ConvertErrorPartialInput = 3 fromEnum ConvertErrorBadUri = 4 fromEnum ConvertErrorNotAbsolutePath = 5 fromEnum ConvertErrorNoMemory = 6 fromEnum (AnotherConvertError k) = k toEnum 0 = ConvertErrorNoConversion toEnum 1 = ConvertErrorIllegalSequence toEnum 2 = ConvertErrorFailed toEnum 3 = ConvertErrorPartialInput toEnum 4 = ConvertErrorBadUri toEnum 5 = ConvertErrorNotAbsolutePath toEnum 6 = ConvertErrorNoMemory toEnum k = AnotherConvertError k instance GErrorClass ConvertError where gerrorClassDomain _ = "g_convert_error" catchConvertError :: IO a -> (ConvertError -> GErrorMessage -> IO a) -> IO a catchConvertError = catchGErrorJustDomain handleConvertError :: (ConvertError -> GErrorMessage -> IO a) -> IO a -> IO a handleConvertError = handleGErrorJustDomain -- struct Data newtype Data = Data (ForeignPtr Data) noData :: Maybe Data noData = Nothing -- callback DataForeachFunc dataForeachFuncClosure :: DataForeachFunc -> IO Closure dataForeachFuncClosure cb = newCClosure =<< mkDataForeachFunc wrapped where wrapped = dataForeachFuncWrapper Nothing cb type DataForeachFuncC = Word32 -> Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkDataForeachFunc :: DataForeachFuncC -> IO (FunPtr DataForeachFuncC) type DataForeachFunc = Word32 -> Ptr () -> IO () noDataForeachFunc :: Maybe DataForeachFunc noDataForeachFunc = Nothing dataForeachFuncWrapper :: Maybe (Ptr (FunPtr (DataForeachFuncC))) -> DataForeachFunc -> Word32 -> Ptr () -> Ptr () -> IO () dataForeachFuncWrapper funptrptr _cb key_id data_ _ = do _cb key_id data_ maybeReleaseFunPtr funptrptr -- struct Date newtype Date = Date (ForeignPtr Date) noDate :: Maybe Date noDate = Nothing foreign import ccall "g_date_get_type" c_g_date_get_type :: IO GType instance BoxedObject Date where boxedType _ = c_g_date_get_type dateReadJulianDays :: Date -> IO Word32 dateReadJulianDays s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val dateReadJulian :: Date -> IO Word32 dateReadJulian s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word32 return val dateReadDmy :: Date -> IO Word32 dateReadDmy s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val dateReadDay :: Date -> IO Word32 dateReadDay s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Word32 return val dateReadMonth :: Date -> IO Word32 dateReadMonth s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word32 return val dateReadYear :: Date -> IO Word32 dateReadYear s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Word32 return val -- method Date::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "Date" -- throws : False -- Skip return : False foreign import ccall "g_date_new" g_date_new :: IO (Ptr Date) dateNew :: (MonadIO m) => m Date dateNew = liftIO $ do result <- g_date_new result' <- (wrapBoxed Date) result return result' -- method Date::new_dmy -- method type : Constructor -- Args : [Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Date" -- throws : False -- Skip return : False foreign import ccall "g_date_new_dmy" g_date_new_dmy :: Word8 -> -- day : TBasicType TUInt8 CUInt -> -- month : TInterface "GLib" "DateMonth" Word16 -> -- year : TBasicType TUInt16 IO (Ptr Date) dateNewDmy :: (MonadIO m) => Word8 -> -- day DateMonth -> -- month Word16 -> -- year m Date dateNewDmy day month year = liftIO $ do let month' = (fromIntegral . fromEnum) month result <- g_date_new_dmy day month' year result' <- (wrapBoxed Date) result return result' -- method Date::new_julian -- method type : Constructor -- Args : [Arg {argName = "julian_day", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "julian_day", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Date" -- throws : False -- Skip return : False foreign import ccall "g_date_new_julian" g_date_new_julian :: Word32 -> -- julian_day : TBasicType TUInt32 IO (Ptr Date) dateNewJulian :: (MonadIO m) => Word32 -> -- julian_day m Date dateNewJulian julian_day = liftIO $ do result <- g_date_new_julian julian_day result' <- (wrapBoxed Date) result return result' -- method Date::add_days -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_days", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_days", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_add_days" g_date_add_days :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word32 -> -- n_days : TBasicType TUInt32 IO () dateAddDays :: (MonadIO m) => Date -> -- _obj Word32 -> -- n_days m () dateAddDays _obj n_days = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_add_days _obj' n_days touchManagedPtr _obj return () -- method Date::add_months -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_months", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_months", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_add_months" g_date_add_months :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word32 -> -- n_months : TBasicType TUInt32 IO () dateAddMonths :: (MonadIO m) => Date -> -- _obj Word32 -> -- n_months m () dateAddMonths _obj n_months = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_add_months _obj' n_months touchManagedPtr _obj return () -- method Date::add_years -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_years", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_years", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_add_years" g_date_add_years :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word32 -> -- n_years : TBasicType TUInt32 IO () dateAddYears :: (MonadIO m) => Date -> -- _obj Word32 -> -- n_years m () dateAddYears _obj n_years = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_add_years _obj' n_years touchManagedPtr _obj return () -- method Date::clamp -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min_date", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_date", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min_date", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_date", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_clamp" g_date_clamp :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Ptr Date -> -- min_date : TInterface "GLib" "Date" Ptr Date -> -- max_date : TInterface "GLib" "Date" IO () dateClamp :: (MonadIO m) => Date -> -- _obj Date -> -- min_date Date -> -- max_date m () dateClamp _obj min_date max_date = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let min_date' = unsafeManagedPtrGetPtr min_date let max_date' = unsafeManagedPtrGetPtr max_date g_date_clamp _obj' min_date' max_date' touchManagedPtr _obj touchManagedPtr min_date touchManagedPtr max_date return () -- method Date::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_dates", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_dates", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_clear" g_date_clear :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word32 -> -- n_dates : TBasicType TUInt32 IO () dateClear :: (MonadIO m) => Date -> -- _obj Word32 -> -- n_dates m () dateClear _obj n_dates = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_clear _obj' n_dates touchManagedPtr _obj return () -- method Date::compare -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rhs", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rhs", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_compare" g_date_compare :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Ptr Date -> -- rhs : TInterface "GLib" "Date" IO Int32 dateCompare :: (MonadIO m) => Date -> -- _obj Date -> -- rhs m Int32 dateCompare _obj rhs = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let rhs' = unsafeManagedPtrGetPtr rhs result <- g_date_compare _obj' rhs' touchManagedPtr _obj touchManagedPtr rhs return result -- method Date::days_between -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "date2", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "date2", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_days_between" g_date_days_between :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Ptr Date -> -- date2 : TInterface "GLib" "Date" IO Int32 dateDaysBetween :: (MonadIO m) => Date -> -- _obj Date -> -- date2 m Int32 dateDaysBetween _obj date2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let date2' = unsafeManagedPtrGetPtr date2 result <- g_date_days_between _obj' date2' touchManagedPtr _obj touchManagedPtr date2 return result -- method Date::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_free" g_date_free :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO () dateFree :: (MonadIO m) => Date -> -- _obj m () dateFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_free _obj' touchManagedPtr _obj return () -- method Date::get_day -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt8 -- throws : False -- Skip return : False foreign import ccall "g_date_get_day" g_date_get_day :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO Word8 dateGetDay :: (MonadIO m) => Date -> -- _obj m Word8 dateGetDay _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_day _obj' touchManagedPtr _obj return result -- method Date::get_day_of_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_get_day_of_year" g_date_get_day_of_year :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO Word32 dateGetDayOfYear :: (MonadIO m) => Date -> -- _obj m Word32 dateGetDayOfYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_day_of_year _obj' touchManagedPtr _obj return result -- method Date::get_iso8601_week_of_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_get_iso8601_week_of_year" g_date_get_iso8601_week_of_year :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO Word32 dateGetIso8601WeekOfYear :: (MonadIO m) => Date -> -- _obj m Word32 dateGetIso8601WeekOfYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_iso8601_week_of_year _obj' touchManagedPtr _obj return result -- method Date::get_julian -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_get_julian" g_date_get_julian :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO Word32 dateGetJulian :: (MonadIO m) => Date -> -- _obj m Word32 dateGetJulian _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_julian _obj' touchManagedPtr _obj return result -- method Date::get_monday_week_of_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_get_monday_week_of_year" g_date_get_monday_week_of_year :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO Word32 dateGetMondayWeekOfYear :: (MonadIO m) => Date -> -- _obj m Word32 dateGetMondayWeekOfYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_monday_week_of_year _obj' touchManagedPtr _obj return result -- method Date::get_month -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateMonth" -- throws : False -- Skip return : False foreign import ccall "g_date_get_month" g_date_get_month :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO CUInt dateGetMonth :: (MonadIO m) => Date -> -- _obj m DateMonth dateGetMonth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_month _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Date::get_sunday_week_of_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_get_sunday_week_of_year" g_date_get_sunday_week_of_year :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO Word32 dateGetSundayWeekOfYear :: (MonadIO m) => Date -> -- _obj m Word32 dateGetSundayWeekOfYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_sunday_week_of_year _obj' touchManagedPtr _obj return result -- method Date::get_weekday -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateWeekday" -- throws : False -- Skip return : False foreign import ccall "g_date_get_weekday" g_date_get_weekday :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO CUInt dateGetWeekday :: (MonadIO m) => Date -> -- _obj m DateWeekday dateGetWeekday _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_weekday _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Date::get_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "g_date_get_year" g_date_get_year :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO Word16 dateGetYear :: (MonadIO m) => Date -> -- _obj m Word16 dateGetYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_get_year _obj' touchManagedPtr _obj return result -- method Date::is_first_of_month -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_is_first_of_month" g_date_is_first_of_month :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO CInt dateIsFirstOfMonth :: (MonadIO m) => Date -> -- _obj m Bool dateIsFirstOfMonth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_is_first_of_month _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Date::is_last_of_month -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_is_last_of_month" g_date_is_last_of_month :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO CInt dateIsLastOfMonth :: (MonadIO m) => Date -> -- _obj m Bool dateIsLastOfMonth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_is_last_of_month _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Date::order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "date2", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "date2", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_order" g_date_order :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Ptr Date -> -- date2 : TInterface "GLib" "Date" IO () dateOrder :: (MonadIO m) => Date -> -- _obj Date -> -- date2 m () dateOrder _obj date2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let date2' = unsafeManagedPtrGetPtr date2 g_date_order _obj' date2' touchManagedPtr _obj touchManagedPtr date2 return () -- method Date::set_day -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_set_day" g_date_set_day :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word8 -> -- day : TBasicType TUInt8 IO () dateSetDay :: (MonadIO m) => Date -> -- _obj Word8 -> -- day m () dateSetDay _obj day = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_set_day _obj' day touchManagedPtr _obj return () -- method Date::set_dmy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_set_dmy" g_date_set_dmy :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word8 -> -- day : TBasicType TUInt8 CUInt -> -- month : TInterface "GLib" "DateMonth" Word16 -> -- y : TBasicType TUInt16 IO () dateSetDmy :: (MonadIO m) => Date -> -- _obj Word8 -> -- day DateMonth -> -- month Word16 -> -- y m () dateSetDmy _obj day month y = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let month' = (fromIntegral . fromEnum) month g_date_set_dmy _obj' day month' y touchManagedPtr _obj return () -- method Date::set_julian -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "julian_date", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "julian_date", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_set_julian" g_date_set_julian :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word32 -> -- julian_date : TBasicType TUInt32 IO () dateSetJulian :: (MonadIO m) => Date -> -- _obj Word32 -> -- julian_date m () dateSetJulian _obj julian_date = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_set_julian _obj' julian_date touchManagedPtr _obj return () -- method Date::set_month -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_set_month" g_date_set_month :: Ptr Date -> -- _obj : TInterface "GLib" "Date" CUInt -> -- month : TInterface "GLib" "DateMonth" IO () dateSetMonth :: (MonadIO m) => Date -> -- _obj DateMonth -> -- month m () dateSetMonth _obj month = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let month' = (fromIntegral . fromEnum) month g_date_set_month _obj' month' touchManagedPtr _obj return () -- method Date::set_parse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_set_parse" g_date_set_parse :: Ptr Date -> -- _obj : TInterface "GLib" "Date" CString -> -- str : TBasicType TUTF8 IO () dateSetParse :: (MonadIO m) => Date -> -- _obj T.Text -> -- str m () dateSetParse _obj str = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj str' <- textToCString str g_date_set_parse _obj' str' touchManagedPtr _obj freeMem str' return () -- method Date::set_time -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "time_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "time_", 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_date_set_time" g_date_set_time :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Int32 -> -- time_ : TBasicType TInt32 IO () {-# DEPRECATED dateSetTime ["(Since version 2.10)","Use g_date_set_time_t() instead."]#-} dateSetTime :: (MonadIO m) => Date -> -- _obj Int32 -> -- time_ m () dateSetTime _obj time_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_set_time _obj' time_ touchManagedPtr _obj return () -- method Date::set_time_t -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timet", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timet", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_set_time_t" g_date_set_time_t :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Int64 -> -- timet : TBasicType TInt64 IO () dateSetTimeT :: (MonadIO m) => Date -> -- _obj Int64 -> -- timet m () dateSetTimeT _obj timet = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_set_time_t _obj' timet touchManagedPtr _obj return () -- method Date::set_time_val -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeval", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeval", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_set_time_val" g_date_set_time_val :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Ptr TimeVal -> -- timeval : TInterface "GLib" "TimeVal" IO () dateSetTimeVal :: (MonadIO m) => Date -> -- _obj TimeVal -> -- timeval m () dateSetTimeVal _obj timeval = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let timeval' = unsafeManagedPtrGetPtr timeval g_date_set_time_val _obj' timeval' touchManagedPtr _obj touchManagedPtr timeval return () -- method Date::set_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_set_year" g_date_set_year :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word16 -> -- year : TBasicType TUInt16 IO () dateSetYear :: (MonadIO m) => Date -> -- _obj Word16 -> -- year m () dateSetYear _obj year = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_set_year _obj' year touchManagedPtr _obj return () -- method Date::subtract_days -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_days", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_days", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_subtract_days" g_date_subtract_days :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word32 -> -- n_days : TBasicType TUInt32 IO () dateSubtractDays :: (MonadIO m) => Date -> -- _obj Word32 -> -- n_days m () dateSubtractDays _obj n_days = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_subtract_days _obj' n_days touchManagedPtr _obj return () -- method Date::subtract_months -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_months", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_months", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_subtract_months" g_date_subtract_months :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word32 -> -- n_months : TBasicType TUInt32 IO () dateSubtractMonths :: (MonadIO m) => Date -> -- _obj Word32 -> -- n_months m () dateSubtractMonths _obj n_months = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_subtract_months _obj' n_months touchManagedPtr _obj return () -- method Date::subtract_years -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_years", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_years", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_subtract_years" g_date_subtract_years :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Word32 -> -- n_years : TBasicType TUInt32 IO () dateSubtractYears :: (MonadIO m) => Date -> -- _obj Word32 -> -- n_years m () dateSubtractYears _obj n_years = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_subtract_years _obj' n_years touchManagedPtr _obj return () -- method Date::to_struct_tm -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tm", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tm", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_to_struct_tm" g_date_to_struct_tm :: Ptr Date -> -- _obj : TInterface "GLib" "Date" Ptr () -> -- tm : TBasicType TVoid IO () dateToStructTm :: (MonadIO m) => Date -> -- _obj Ptr () -> -- tm m () dateToStructTm _obj tm = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_to_struct_tm _obj' tm touchManagedPtr _obj return () -- method Date::valid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_valid" g_date_valid :: Ptr Date -> -- _obj : TInterface "GLib" "Date" IO CInt dateValid :: (MonadIO m) => Date -> -- _obj m Bool dateValid _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_valid _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- Enum DateDMY data DateDMY = DateDMYDay | DateDMYMonth | DateDMYYear | AnotherDateDMY Int deriving (Show, Eq) instance Enum DateDMY where fromEnum DateDMYDay = 0 fromEnum DateDMYMonth = 1 fromEnum DateDMYYear = 2 fromEnum (AnotherDateDMY k) = k toEnum 0 = DateDMYDay toEnum 1 = DateDMYMonth toEnum 2 = DateDMYYear toEnum k = AnotherDateDMY k -- Enum DateMonth data DateMonth = DateMonthBadMonth | DateMonthJanuary | DateMonthFebruary | DateMonthMarch | DateMonthApril | DateMonthMay | DateMonthJune | DateMonthJuly | DateMonthAugust | DateMonthSeptember | DateMonthOctober | DateMonthNovember | DateMonthDecember | AnotherDateMonth Int deriving (Show, Eq) instance Enum DateMonth where fromEnum DateMonthBadMonth = 0 fromEnum DateMonthJanuary = 1 fromEnum DateMonthFebruary = 2 fromEnum DateMonthMarch = 3 fromEnum DateMonthApril = 4 fromEnum DateMonthMay = 5 fromEnum DateMonthJune = 6 fromEnum DateMonthJuly = 7 fromEnum DateMonthAugust = 8 fromEnum DateMonthSeptember = 9 fromEnum DateMonthOctober = 10 fromEnum DateMonthNovember = 11 fromEnum DateMonthDecember = 12 fromEnum (AnotherDateMonth k) = k toEnum 0 = DateMonthBadMonth toEnum 1 = DateMonthJanuary toEnum 2 = DateMonthFebruary toEnum 3 = DateMonthMarch toEnum 4 = DateMonthApril toEnum 5 = DateMonthMay toEnum 6 = DateMonthJune toEnum 7 = DateMonthJuly toEnum 8 = DateMonthAugust toEnum 9 = DateMonthSeptember toEnum 10 = DateMonthOctober toEnum 11 = DateMonthNovember toEnum 12 = DateMonthDecember toEnum k = AnotherDateMonth k -- struct DateTime newtype DateTime = DateTime (ForeignPtr DateTime) noDateTime :: Maybe DateTime noDateTime = Nothing foreign import ccall "g_date_time_get_type" c_g_date_time_get_type :: IO GType instance BoxedObject DateTime where boxedType _ = c_g_date_time_get_type -- method DateTime::new -- method type : Constructor -- Args : [Arg {argName = "tz", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hour", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minute", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tz", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hour", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minute", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new" g_date_time_new :: Ptr TimeZone -> -- tz : TInterface "GLib" "TimeZone" Int32 -> -- year : TBasicType TInt32 Int32 -> -- month : TBasicType TInt32 Int32 -> -- day : TBasicType TInt32 Int32 -> -- hour : TBasicType TInt32 Int32 -> -- minute : TBasicType TInt32 CDouble -> -- seconds : TBasicType TDouble IO (Ptr DateTime) dateTimeNew :: (MonadIO m) => TimeZone -> -- tz Int32 -> -- year Int32 -> -- month Int32 -> -- day Int32 -> -- hour Int32 -> -- minute Double -> -- seconds m DateTime dateTimeNew tz year month day hour minute seconds = liftIO $ do let tz' = unsafeManagedPtrGetPtr tz let seconds' = realToFrac seconds result <- g_date_time_new tz' year month day hour minute seconds' result' <- (wrapBoxed DateTime) result touchManagedPtr tz return result' -- method DateTime::new_from_timeval_local -- method type : Constructor -- Args : [Arg {argName = "tv", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tv", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_from_timeval_local" g_date_time_new_from_timeval_local :: Ptr TimeVal -> -- tv : TInterface "GLib" "TimeVal" IO (Ptr DateTime) dateTimeNewFromTimevalLocal :: (MonadIO m) => TimeVal -> -- tv m DateTime dateTimeNewFromTimevalLocal tv = liftIO $ do let tv' = unsafeManagedPtrGetPtr tv result <- g_date_time_new_from_timeval_local tv' result' <- (wrapBoxed DateTime) result touchManagedPtr tv return result' -- method DateTime::new_from_timeval_utc -- method type : Constructor -- Args : [Arg {argName = "tv", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tv", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_from_timeval_utc" g_date_time_new_from_timeval_utc :: Ptr TimeVal -> -- tv : TInterface "GLib" "TimeVal" IO (Ptr DateTime) dateTimeNewFromTimevalUtc :: (MonadIO m) => TimeVal -> -- tv m DateTime dateTimeNewFromTimevalUtc tv = liftIO $ do let tv' = unsafeManagedPtrGetPtr tv result <- g_date_time_new_from_timeval_utc tv' result' <- (wrapBoxed DateTime) result touchManagedPtr tv return result' -- method DateTime::new_from_unix_local -- method type : Constructor -- Args : [Arg {argName = "t", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "t", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_from_unix_local" g_date_time_new_from_unix_local :: Int64 -> -- t : TBasicType TInt64 IO (Ptr DateTime) dateTimeNewFromUnixLocal :: (MonadIO m) => Int64 -> -- t m DateTime dateTimeNewFromUnixLocal t = liftIO $ do result <- g_date_time_new_from_unix_local t result' <- (wrapBoxed DateTime) result return result' -- method DateTime::new_from_unix_utc -- method type : Constructor -- Args : [Arg {argName = "t", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "t", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_from_unix_utc" g_date_time_new_from_unix_utc :: Int64 -> -- t : TBasicType TInt64 IO (Ptr DateTime) dateTimeNewFromUnixUtc :: (MonadIO m) => Int64 -> -- t m DateTime dateTimeNewFromUnixUtc t = liftIO $ do result <- g_date_time_new_from_unix_utc t result' <- (wrapBoxed DateTime) result return result' -- method DateTime::new_local -- method type : Constructor -- Args : [Arg {argName = "year", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hour", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minute", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "year", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hour", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minute", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_local" g_date_time_new_local :: Int32 -> -- year : TBasicType TInt32 Int32 -> -- month : TBasicType TInt32 Int32 -> -- day : TBasicType TInt32 Int32 -> -- hour : TBasicType TInt32 Int32 -> -- minute : TBasicType TInt32 CDouble -> -- seconds : TBasicType TDouble IO (Ptr DateTime) dateTimeNewLocal :: (MonadIO m) => Int32 -> -- year Int32 -> -- month Int32 -> -- day Int32 -> -- hour Int32 -> -- minute Double -> -- seconds m DateTime dateTimeNewLocal year month day hour minute seconds = liftIO $ do let seconds' = realToFrac seconds result <- g_date_time_new_local year month day hour minute seconds' result' <- (wrapBoxed DateTime) result return result' -- method DateTime::new_now -- method type : Constructor -- Args : [Arg {argName = "tz", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tz", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_now" g_date_time_new_now :: Ptr TimeZone -> -- tz : TInterface "GLib" "TimeZone" IO (Ptr DateTime) dateTimeNewNow :: (MonadIO m) => TimeZone -> -- tz m DateTime dateTimeNewNow tz = liftIO $ do let tz' = unsafeManagedPtrGetPtr tz result <- g_date_time_new_now tz' result' <- (wrapBoxed DateTime) result touchManagedPtr tz return result' -- method DateTime::new_now_local -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_now_local" g_date_time_new_now_local :: IO (Ptr DateTime) dateTimeNewNowLocal :: (MonadIO m) => m DateTime dateTimeNewNowLocal = liftIO $ do result <- g_date_time_new_now_local result' <- (wrapBoxed DateTime) result return result' -- method DateTime::new_now_utc -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_now_utc" g_date_time_new_now_utc :: IO (Ptr DateTime) dateTimeNewNowUtc :: (MonadIO m) => m DateTime dateTimeNewNowUtc = liftIO $ do result <- g_date_time_new_now_utc result' <- (wrapBoxed DateTime) result return result' -- method DateTime::new_utc -- method type : Constructor -- Args : [Arg {argName = "year", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hour", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minute", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "year", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "day", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hour", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minute", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_new_utc" g_date_time_new_utc :: Int32 -> -- year : TBasicType TInt32 Int32 -> -- month : TBasicType TInt32 Int32 -> -- day : TBasicType TInt32 Int32 -> -- hour : TBasicType TInt32 Int32 -> -- minute : TBasicType TInt32 CDouble -> -- seconds : TBasicType TDouble IO (Ptr DateTime) dateTimeNewUtc :: (MonadIO m) => Int32 -> -- year Int32 -> -- month Int32 -> -- day Int32 -> -- hour Int32 -> -- minute Double -> -- seconds m DateTime dateTimeNewUtc year month day hour minute seconds = liftIO $ do let seconds' = realToFrac seconds result <- g_date_time_new_utc year month day hour minute seconds' result' <- (wrapBoxed DateTime) result return result' -- method DateTime::add -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timespan", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timespan", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add" g_date_time_add :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Int64 -> -- timespan : TBasicType TInt64 IO (Ptr DateTime) dateTimeAdd :: (MonadIO m) => DateTime -> -- _obj Int64 -> -- timespan m DateTime dateTimeAdd _obj timespan = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_add _obj' timespan result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::add_days -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "days", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "days", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add_days" g_date_time_add_days :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Int32 -> -- days : TBasicType TInt32 IO (Ptr DateTime) dateTimeAddDays :: (MonadIO m) => DateTime -> -- _obj Int32 -> -- days m DateTime dateTimeAddDays _obj days = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_add_days _obj' days result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::add_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "years", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "months", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "days", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hours", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minutes", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "years", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "months", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "days", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hours", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minutes", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add_full" g_date_time_add_full :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Int32 -> -- years : TBasicType TInt32 Int32 -> -- months : TBasicType TInt32 Int32 -> -- days : TBasicType TInt32 Int32 -> -- hours : TBasicType TInt32 Int32 -> -- minutes : TBasicType TInt32 CDouble -> -- seconds : TBasicType TDouble IO (Ptr DateTime) dateTimeAddFull :: (MonadIO m) => DateTime -> -- _obj Int32 -> -- years Int32 -> -- months Int32 -> -- days Int32 -> -- hours Int32 -> -- minutes Double -> -- seconds m DateTime dateTimeAddFull _obj years months days hours minutes seconds = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let seconds' = realToFrac seconds result <- g_date_time_add_full _obj' years months days hours minutes seconds' result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::add_hours -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hours", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hours", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add_hours" g_date_time_add_hours :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Int32 -> -- hours : TBasicType TInt32 IO (Ptr DateTime) dateTimeAddHours :: (MonadIO m) => DateTime -> -- _obj Int32 -> -- hours m DateTime dateTimeAddHours _obj hours = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_add_hours _obj' hours result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::add_minutes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minutes", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minutes", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add_minutes" g_date_time_add_minutes :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Int32 -> -- minutes : TBasicType TInt32 IO (Ptr DateTime) dateTimeAddMinutes :: (MonadIO m) => DateTime -> -- _obj Int32 -> -- minutes m DateTime dateTimeAddMinutes _obj minutes = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_add_minutes _obj' minutes result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::add_months -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "months", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "months", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add_months" g_date_time_add_months :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Int32 -> -- months : TBasicType TInt32 IO (Ptr DateTime) dateTimeAddMonths :: (MonadIO m) => DateTime -> -- _obj Int32 -> -- months m DateTime dateTimeAddMonths _obj months = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_add_months _obj' months result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::add_seconds -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seconds", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add_seconds" g_date_time_add_seconds :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" CDouble -> -- seconds : TBasicType TDouble IO (Ptr DateTime) dateTimeAddSeconds :: (MonadIO m) => DateTime -> -- _obj Double -> -- seconds m DateTime dateTimeAddSeconds _obj seconds = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let seconds' = realToFrac seconds result <- g_date_time_add_seconds _obj' seconds' result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::add_weeks -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "weeks", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "weeks", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add_weeks" g_date_time_add_weeks :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Int32 -> -- weeks : TBasicType TInt32 IO (Ptr DateTime) dateTimeAddWeeks :: (MonadIO m) => DateTime -> -- _obj Int32 -> -- weeks m DateTime dateTimeAddWeeks _obj weeks = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_add_weeks _obj' weeks result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::add_years -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "years", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "years", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_add_years" g_date_time_add_years :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Int32 -> -- years : TBasicType TInt32 IO (Ptr DateTime) dateTimeAddYears :: (MonadIO m) => DateTime -> -- _obj Int32 -> -- years m DateTime dateTimeAddYears _obj years = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_add_years _obj' years result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::difference -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "begin", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "begin", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_date_time_difference" g_date_time_difference :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Ptr DateTime -> -- begin : TInterface "GLib" "DateTime" IO Int64 dateTimeDifference :: (MonadIO m) => DateTime -> -- _obj DateTime -> -- begin m Int64 dateTimeDifference _obj begin = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let begin' = unsafeManagedPtrGetPtr begin result <- g_date_time_difference _obj' begin' touchManagedPtr _obj touchManagedPtr begin return result -- method DateTime::format -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_date_time_format" g_date_time_format :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" CString -> -- format : TBasicType TUTF8 IO CString dateTimeFormat :: (MonadIO m) => DateTime -> -- _obj T.Text -> -- format m T.Text dateTimeFormat _obj format = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj format' <- textToCString format result <- g_date_time_format _obj' format' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem format' return result' -- method DateTime::get_day_of_month -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_day_of_month" g_date_time_get_day_of_month :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetDayOfMonth :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetDayOfMonth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_day_of_month _obj' touchManagedPtr _obj return result -- method DateTime::get_day_of_week -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_day_of_week" g_date_time_get_day_of_week :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetDayOfWeek :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetDayOfWeek _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_day_of_week _obj' touchManagedPtr _obj return result -- method DateTime::get_day_of_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_day_of_year" g_date_time_get_day_of_year :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetDayOfYear :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetDayOfYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_day_of_year _obj' touchManagedPtr _obj return result -- method DateTime::get_hour -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_hour" g_date_time_get_hour :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetHour :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetHour _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_hour _obj' touchManagedPtr _obj return result -- method DateTime::get_microsecond -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_microsecond" g_date_time_get_microsecond :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetMicrosecond :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetMicrosecond _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_microsecond _obj' touchManagedPtr _obj return result -- method DateTime::get_minute -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_minute" g_date_time_get_minute :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetMinute :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetMinute _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_minute _obj' touchManagedPtr _obj return result -- method DateTime::get_month -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_month" g_date_time_get_month :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetMonth :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetMonth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_month _obj' touchManagedPtr _obj return result -- method DateTime::get_second -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_second" g_date_time_get_second :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetSecond :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetSecond _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_second _obj' touchManagedPtr _obj return result -- method DateTime::get_seconds -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_seconds" g_date_time_get_seconds :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO CDouble dateTimeGetSeconds :: (MonadIO m) => DateTime -> -- _obj m Double dateTimeGetSeconds _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_seconds _obj' let result' = realToFrac result touchManagedPtr _obj return result' -- method DateTime::get_timezone_abbreviation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_timezone_abbreviation" g_date_time_get_timezone_abbreviation :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO CString dateTimeGetTimezoneAbbreviation :: (MonadIO m) => DateTime -> -- _obj m T.Text dateTimeGetTimezoneAbbreviation _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_timezone_abbreviation _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method DateTime::get_utc_offset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_utc_offset" g_date_time_get_utc_offset :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int64 dateTimeGetUtcOffset :: (MonadIO m) => DateTime -> -- _obj m Int64 dateTimeGetUtcOffset _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_utc_offset _obj' touchManagedPtr _obj return result -- method DateTime::get_week_numbering_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_week_numbering_year" g_date_time_get_week_numbering_year :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetWeekNumberingYear :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetWeekNumberingYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_week_numbering_year _obj' touchManagedPtr _obj return result -- method DateTime::get_week_of_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_week_of_year" g_date_time_get_week_of_year :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetWeekOfYear :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetWeekOfYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_week_of_year _obj' touchManagedPtr _obj return result -- method DateTime::get_year -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_year" g_date_time_get_year :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int32 dateTimeGetYear :: (MonadIO m) => DateTime -> -- _obj m Int32 dateTimeGetYear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_get_year _obj' touchManagedPtr _obj return result -- method DateTime::get_ymd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "month", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "day", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_time_get_ymd" g_date_time_get_ymd :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Ptr Int32 -> -- year : TBasicType TInt32 Ptr Int32 -> -- month : TBasicType TInt32 Ptr Int32 -> -- day : TBasicType TInt32 IO () dateTimeGetYmd :: (MonadIO m) => DateTime -> -- _obj m (Int32,Int32,Int32) dateTimeGetYmd _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj year <- allocMem :: IO (Ptr Int32) month <- allocMem :: IO (Ptr Int32) day <- allocMem :: IO (Ptr Int32) g_date_time_get_ymd _obj' year month day year' <- peek year month' <- peek month day' <- peek day touchManagedPtr _obj freeMem year freeMem month freeMem day return (year', month', day') -- method DateTime::is_daylight_savings -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_time_is_daylight_savings" g_date_time_is_daylight_savings :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO CInt dateTimeIsDaylightSavings :: (MonadIO m) => DateTime -> -- _obj m Bool dateTimeIsDaylightSavings _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_is_daylight_savings _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method DateTime::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_ref" g_date_time_ref :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO (Ptr DateTime) dateTimeRef :: (MonadIO m) => DateTime -> -- _obj m DateTime dateTimeRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_ref _obj' result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::to_local -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_to_local" g_date_time_to_local :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO (Ptr DateTime) dateTimeToLocal :: (MonadIO m) => DateTime -> -- _obj m DateTime dateTimeToLocal _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_to_local _obj' result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::to_timeval -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tv", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tv", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_time_to_timeval" g_date_time_to_timeval :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Ptr TimeVal -> -- tv : TInterface "GLib" "TimeVal" IO CInt dateTimeToTimeval :: (MonadIO m) => DateTime -> -- _obj TimeVal -> -- tv m Bool dateTimeToTimeval _obj tv = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let tv' = unsafeManagedPtrGetPtr tv result <- g_date_time_to_timeval _obj' tv' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr tv return result' -- method DateTime::to_timezone -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tz", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tz", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_to_timezone" g_date_time_to_timezone :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" Ptr TimeZone -> -- tz : TInterface "GLib" "TimeZone" IO (Ptr DateTime) dateTimeToTimezone :: (MonadIO m) => DateTime -> -- _obj TimeZone -> -- tz m DateTime dateTimeToTimezone _obj tz = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let tz' = unsafeManagedPtrGetPtr tz result <- g_date_time_to_timezone _obj' tz' result' <- (wrapBoxed DateTime) result touchManagedPtr _obj touchManagedPtr tz return result' -- method DateTime::to_unix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_date_time_to_unix" g_date_time_to_unix :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO Int64 dateTimeToUnix :: (MonadIO m) => DateTime -> -- _obj m Int64 dateTimeToUnix _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_to_unix _obj' touchManagedPtr _obj return result -- method DateTime::to_utc -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "DateTime" -- throws : False -- Skip return : False foreign import ccall "g_date_time_to_utc" g_date_time_to_utc :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO (Ptr DateTime) dateTimeToUtc :: (MonadIO m) => DateTime -> -- _obj m DateTime dateTimeToUtc _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_date_time_to_utc _obj' result' <- (wrapBoxed DateTime) result touchManagedPtr _obj return result' -- method DateTime::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "DateTime", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_date_time_unref" g_date_time_unref :: Ptr DateTime -> -- _obj : TInterface "GLib" "DateTime" IO () dateTimeUnref :: (MonadIO m) => DateTime -> -- _obj m () dateTimeUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_date_time_unref _obj' touchManagedPtr _obj return () -- Enum DateWeekday data DateWeekday = DateWeekdayBadWeekday | DateWeekdayMonday | DateWeekdayTuesday | DateWeekdayWednesday | DateWeekdayThursday | DateWeekdayFriday | DateWeekdaySaturday | DateWeekdaySunday | AnotherDateWeekday Int deriving (Show, Eq) instance Enum DateWeekday where fromEnum DateWeekdayBadWeekday = 0 fromEnum DateWeekdayMonday = 1 fromEnum DateWeekdayTuesday = 2 fromEnum DateWeekdayWednesday = 3 fromEnum DateWeekdayThursday = 4 fromEnum DateWeekdayFriday = 5 fromEnum DateWeekdaySaturday = 6 fromEnum DateWeekdaySunday = 7 fromEnum (AnotherDateWeekday k) = k toEnum 0 = DateWeekdayBadWeekday toEnum 1 = DateWeekdayMonday toEnum 2 = DateWeekdayTuesday toEnum 3 = DateWeekdayWednesday toEnum 4 = DateWeekdayThursday toEnum 5 = DateWeekdayFriday toEnum 6 = DateWeekdaySaturday toEnum 7 = DateWeekdaySunday toEnum k = AnotherDateWeekday k -- struct DebugKey newtype DebugKey = DebugKey (ForeignPtr DebugKey) noDebugKey :: Maybe DebugKey noDebugKey = Nothing debugKeyReadKey :: DebugKey -> IO T.Text debugKeyReadKey s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' debugKeyReadValue :: DebugKey -> IO Word32 debugKeyReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val -- callback DestroyNotify destroyNotifyClosure :: DestroyNotify -> IO Closure destroyNotifyClosure cb = newCClosure =<< mkDestroyNotify wrapped where wrapped = destroyNotifyWrapper Nothing cb type DestroyNotifyC = Ptr () -> IO () foreign import ccall "wrapper" mkDestroyNotify :: DestroyNotifyC -> IO (FunPtr DestroyNotifyC) type DestroyNotify = Ptr () -> IO () noDestroyNotify :: Maybe DestroyNotify noDestroyNotify = Nothing destroyNotifyWrapper :: Maybe (Ptr (FunPtr (DestroyNotifyC))) -> DestroyNotify -> Ptr () -> IO () destroyNotifyWrapper funptrptr _cb data_ = do _cb data_ maybeReleaseFunPtr funptrptr -- struct Dir newtype Dir = Dir (ForeignPtr Dir) noDir :: Maybe Dir noDir = Nothing -- method Dir::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Dir", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Dir", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dir_close" g_dir_close :: Ptr Dir -> -- _obj : TInterface "GLib" "Dir" IO () dirClose :: (MonadIO m) => Dir -> -- _obj m () dirClose _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dir_close _obj' touchManagedPtr _obj return () -- method Dir::read_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Dir", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Dir", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dir_read_name" g_dir_read_name :: Ptr Dir -> -- _obj : TInterface "GLib" "Dir" IO CString dirReadName :: (MonadIO m) => Dir -> -- _obj m T.Text dirReadName _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_dir_read_name _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method Dir::rewind -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Dir", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Dir", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dir_rewind" g_dir_rewind :: Ptr Dir -> -- _obj : TInterface "GLib" "Dir" IO () dirRewind :: (MonadIO m) => Dir -> -- _obj m () dirRewind _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dir_rewind _obj' touchManagedPtr _obj return () -- union DoubleIEEE754 newtype DoubleIEEE754 = DoubleIEEE754 (ForeignPtr DoubleIEEE754) noDoubleIEEE754 :: Maybe DoubleIEEE754 noDoubleIEEE754 = Nothing doubleIEEE754ReadVDouble :: DoubleIEEE754 -> IO Double doubleIEEE754ReadVDouble s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CDouble let val' = realToFrac val return val' -- callback EqualFunc equalFuncClosure :: EqualFunc -> IO Closure equalFuncClosure cb = newCClosure =<< mkEqualFunc wrapped where wrapped = equalFuncWrapper Nothing cb type EqualFuncC = Ptr () -> Ptr () -> IO CInt foreign import ccall "wrapper" mkEqualFunc :: EqualFuncC -> IO (FunPtr EqualFuncC) type EqualFunc = Ptr () -> Ptr () -> IO Bool noEqualFunc :: Maybe EqualFunc noEqualFunc = Nothing equalFuncWrapper :: Maybe (Ptr (FunPtr (EqualFuncC))) -> EqualFunc -> Ptr () -> Ptr () -> IO CInt equalFuncWrapper funptrptr _cb a b = do result <- _cb a b maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Enum ErrorType data ErrorType = ErrorTypeUnknown | ErrorTypeUnexpEof | ErrorTypeUnexpEofInString | ErrorTypeUnexpEofInComment | ErrorTypeNonDigitInConst | ErrorTypeDigitRadix | ErrorTypeFloatRadix | ErrorTypeFloatMalformed | AnotherErrorType Int deriving (Show, Eq) instance Enum ErrorType where fromEnum ErrorTypeUnknown = 0 fromEnum ErrorTypeUnexpEof = 1 fromEnum ErrorTypeUnexpEofInString = 2 fromEnum ErrorTypeUnexpEofInComment = 3 fromEnum ErrorTypeNonDigitInConst = 4 fromEnum ErrorTypeDigitRadix = 5 fromEnum ErrorTypeFloatRadix = 6 fromEnum ErrorTypeFloatMalformed = 7 fromEnum (AnotherErrorType k) = k toEnum 0 = ErrorTypeUnknown toEnum 1 = ErrorTypeUnexpEof toEnum 2 = ErrorTypeUnexpEofInString toEnum 3 = ErrorTypeUnexpEofInComment toEnum 4 = ErrorTypeNonDigitInConst toEnum 5 = ErrorTypeDigitRadix toEnum 6 = ErrorTypeFloatRadix toEnum 7 = ErrorTypeFloatMalformed toEnum k = AnotherErrorType k -- Enum FileError data FileError = FileErrorExist | FileErrorIsdir | FileErrorAcces | FileErrorNametoolong | FileErrorNoent | FileErrorNotdir | FileErrorNxio | FileErrorNodev | FileErrorRofs | FileErrorTxtbsy | FileErrorFault | FileErrorLoop | FileErrorNospc | FileErrorNomem | FileErrorMfile | FileErrorNfile | FileErrorBadf | FileErrorInval | FileErrorPipe | FileErrorAgain | FileErrorIntr | FileErrorIo | FileErrorPerm | FileErrorNosys | FileErrorFailed | AnotherFileError Int deriving (Show, Eq) instance Enum FileError where fromEnum FileErrorExist = 0 fromEnum FileErrorIsdir = 1 fromEnum FileErrorAcces = 2 fromEnum FileErrorNametoolong = 3 fromEnum FileErrorNoent = 4 fromEnum FileErrorNotdir = 5 fromEnum FileErrorNxio = 6 fromEnum FileErrorNodev = 7 fromEnum FileErrorRofs = 8 fromEnum FileErrorTxtbsy = 9 fromEnum FileErrorFault = 10 fromEnum FileErrorLoop = 11 fromEnum FileErrorNospc = 12 fromEnum FileErrorNomem = 13 fromEnum FileErrorMfile = 14 fromEnum FileErrorNfile = 15 fromEnum FileErrorBadf = 16 fromEnum FileErrorInval = 17 fromEnum FileErrorPipe = 18 fromEnum FileErrorAgain = 19 fromEnum FileErrorIntr = 20 fromEnum FileErrorIo = 21 fromEnum FileErrorPerm = 22 fromEnum FileErrorNosys = 23 fromEnum FileErrorFailed = 24 fromEnum (AnotherFileError k) = k toEnum 0 = FileErrorExist toEnum 1 = FileErrorIsdir toEnum 2 = FileErrorAcces toEnum 3 = FileErrorNametoolong toEnum 4 = FileErrorNoent toEnum 5 = FileErrorNotdir toEnum 6 = FileErrorNxio toEnum 7 = FileErrorNodev toEnum 8 = FileErrorRofs toEnum 9 = FileErrorTxtbsy toEnum 10 = FileErrorFault toEnum 11 = FileErrorLoop toEnum 12 = FileErrorNospc toEnum 13 = FileErrorNomem toEnum 14 = FileErrorMfile toEnum 15 = FileErrorNfile toEnum 16 = FileErrorBadf toEnum 17 = FileErrorInval toEnum 18 = FileErrorPipe toEnum 19 = FileErrorAgain toEnum 20 = FileErrorIntr toEnum 21 = FileErrorIo toEnum 22 = FileErrorPerm toEnum 23 = FileErrorNosys toEnum 24 = FileErrorFailed toEnum k = AnotherFileError k instance GErrorClass FileError where gerrorClassDomain _ = "g-file-error-quark" catchFileError :: IO a -> (FileError -> GErrorMessage -> IO a) -> IO a catchFileError = catchGErrorJustDomain handleFileError :: (FileError -> GErrorMessage -> IO a) -> IO a -> IO a handleFileError = handleGErrorJustDomain -- Flags FileTest data FileTest = FileTestIsRegular | FileTestIsSymlink | FileTestIsDir | FileTestIsExecutable | FileTestExists | AnotherFileTest Int deriving (Show, Eq) instance Enum FileTest where fromEnum FileTestIsRegular = 1 fromEnum FileTestIsSymlink = 2 fromEnum FileTestIsDir = 4 fromEnum FileTestIsExecutable = 8 fromEnum FileTestExists = 16 fromEnum (AnotherFileTest k) = k toEnum 1 = FileTestIsRegular toEnum 2 = FileTestIsSymlink toEnum 4 = FileTestIsDir toEnum 8 = FileTestIsExecutable toEnum 16 = FileTestExists toEnum k = AnotherFileTest k instance IsGFlag FileTest -- union FloatIEEE754 newtype FloatIEEE754 = FloatIEEE754 (ForeignPtr FloatIEEE754) noFloatIEEE754 :: Maybe FloatIEEE754 noFloatIEEE754 = Nothing floatIEEE754ReadVFloat :: FloatIEEE754 -> IO Float floatIEEE754ReadVFloat s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CFloat let val' = realToFrac val return val' -- Flags FormatSizeFlags data FormatSizeFlags = FormatSizeFlagsDefault | FormatSizeFlagsLongFormat | FormatSizeFlagsIecUnits | AnotherFormatSizeFlags Int deriving (Show, Eq) instance Enum FormatSizeFlags where fromEnum FormatSizeFlagsDefault = 0 fromEnum FormatSizeFlagsLongFormat = 1 fromEnum FormatSizeFlagsIecUnits = 2 fromEnum (AnotherFormatSizeFlags k) = k toEnum 0 = FormatSizeFlagsDefault toEnum 1 = FormatSizeFlagsLongFormat toEnum 2 = FormatSizeFlagsIecUnits toEnum k = AnotherFormatSizeFlags k instance IsGFlag FormatSizeFlags -- callback FreeFunc freeFuncClosure :: FreeFunc -> IO Closure freeFuncClosure cb = newCClosure =<< mkFreeFunc wrapped where wrapped = freeFuncWrapper Nothing cb type FreeFuncC = Ptr () -> IO () foreign import ccall "wrapper" mkFreeFunc :: FreeFuncC -> IO (FunPtr FreeFuncC) type FreeFunc = Ptr () -> IO () noFreeFunc :: Maybe FreeFunc noFreeFunc = Nothing freeFuncWrapper :: Maybe (Ptr (FunPtr (FreeFuncC))) -> FreeFunc -> Ptr () -> IO () freeFuncWrapper funptrptr _cb data_ = do _cb data_ maybeReleaseFunPtr funptrptr -- callback Func funcClosure :: Func -> IO Closure funcClosure cb = newCClosure =<< mkFunc wrapped where wrapped = funcWrapper Nothing cb type FuncC = Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkFunc :: FuncC -> IO (FunPtr FuncC) type Func = Ptr () -> IO () noFunc :: Maybe Func noFunc = Nothing funcWrapper :: Maybe (Ptr (FunPtr (FuncC))) -> Func -> Ptr () -> Ptr () -> IO () funcWrapper funptrptr _cb data_ _ = do _cb data_ maybeReleaseFunPtr funptrptr -- callback HFunc hFuncClosure :: HFunc -> IO Closure hFuncClosure cb = newCClosure =<< mkHFunc wrapped where wrapped = hFuncWrapper Nothing cb type HFuncC = Ptr () -> Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkHFunc :: HFuncC -> IO (FunPtr HFuncC) type HFunc = Ptr () -> Ptr () -> IO () noHFunc :: Maybe HFunc noHFunc = Nothing hFuncWrapper :: Maybe (Ptr (FunPtr (HFuncC))) -> HFunc -> Ptr () -> Ptr () -> Ptr () -> IO () hFuncWrapper funptrptr _cb key value _ = do _cb key value maybeReleaseFunPtr funptrptr -- callback HRFunc hRFuncClosure :: HRFunc -> IO Closure hRFuncClosure cb = newCClosure =<< mkHRFunc wrapped where wrapped = hRFuncWrapper Nothing cb type HRFuncC = Ptr () -> Ptr () -> Ptr () -> IO CInt foreign import ccall "wrapper" mkHRFunc :: HRFuncC -> IO (FunPtr HRFuncC) type HRFunc = Ptr () -> Ptr () -> IO Bool noHRFunc :: Maybe HRFunc noHRFunc = Nothing hRFuncWrapper :: Maybe (Ptr (FunPtr (HRFuncC))) -> HRFunc -> Ptr () -> Ptr () -> Ptr () -> IO CInt hRFuncWrapper funptrptr _cb key value _ = do result <- _cb key value maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback HashFunc hashFuncClosure :: HashFunc -> IO Closure hashFuncClosure cb = newCClosure =<< mkHashFunc wrapped where wrapped = hashFuncWrapper Nothing cb type HashFuncC = Ptr () -> IO Word32 foreign import ccall "wrapper" mkHashFunc :: HashFuncC -> IO (FunPtr HashFuncC) type HashFunc = Ptr () -> IO Word32 noHashFunc :: Maybe HashFunc noHashFunc = Nothing hashFuncWrapper :: Maybe (Ptr (FunPtr (HashFuncC))) -> HashFunc -> Ptr () -> IO Word32 hashFuncWrapper funptrptr _cb key = do result <- _cb key maybeReleaseFunPtr funptrptr return result -- struct HashTableIter newtype HashTableIter = HashTableIter (ForeignPtr HashTableIter) noHashTableIter :: Maybe HashTableIter noHashTableIter = Nothing -- method HashTableIter::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hash_table_iter_init" g_hash_table_iter_init :: Ptr HashTableIter -> -- _obj : TInterface "GLib" "HashTableIter" Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) IO () hashTableIterInit :: (MonadIO m) => HashTableIter -> -- _obj Map.Map (Ptr ()) (Ptr ()) -> -- hash_table m () hashTableIterInit _obj hash_table = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' g_hash_table_iter_init _obj' hash_table'''' touchManagedPtr _obj unrefGHashTable hash_table'''' return () -- method HashTableIter::next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hash_table_iter_next" g_hash_table_iter_next :: Ptr HashTableIter -> -- _obj : TInterface "GLib" "HashTableIter" Ptr () -> -- key : TBasicType TVoid Ptr () -> -- value : TBasicType TVoid IO CInt hashTableIterNext :: (MonadIO m) => HashTableIter -> -- _obj Maybe (Ptr ()) -> -- key Maybe (Ptr ()) -> -- value m Bool hashTableIterNext _obj key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeKey <- case key of Nothing -> return nullPtr Just jKey -> do return jKey maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do return jValue result <- g_hash_table_iter_next _obj' maybeKey maybeValue let result' = (/= 0) result touchManagedPtr _obj return result' -- method HashTableIter::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hash_table_iter_remove" g_hash_table_iter_remove :: Ptr HashTableIter -> -- _obj : TInterface "GLib" "HashTableIter" IO () hashTableIterRemove :: (MonadIO m) => HashTableIter -> -- _obj m () hashTableIterRemove _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_hash_table_iter_remove _obj' touchManagedPtr _obj return () -- method HashTableIter::replace -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hash_table_iter_replace" g_hash_table_iter_replace :: Ptr HashTableIter -> -- _obj : TInterface "GLib" "HashTableIter" Ptr () -> -- value : TBasicType TVoid IO () hashTableIterReplace :: (MonadIO m) => HashTableIter -> -- _obj Ptr () -> -- value m () hashTableIterReplace _obj value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_hash_table_iter_replace _obj' value touchManagedPtr _obj return () -- method HashTableIter::steal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HashTableIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hash_table_iter_steal" g_hash_table_iter_steal :: Ptr HashTableIter -> -- _obj : TInterface "GLib" "HashTableIter" IO () hashTableIterSteal :: (MonadIO m) => HashTableIter -> -- _obj m () hashTableIterSteal _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_hash_table_iter_steal _obj' touchManagedPtr _obj return () -- struct Hmac newtype Hmac = Hmac (ForeignPtr Hmac) noHmac :: Maybe Hmac noHmac = Nothing -- method Hmac::get_digest -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Hmac", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "digest_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Hmac", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "digest_len", 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_hmac_get_digest" g_hmac_get_digest :: Ptr Hmac -> -- _obj : TInterface "GLib" "Hmac" Word8 -> -- buffer : TBasicType TUInt8 Word64 -> -- digest_len : TBasicType TUInt64 IO () hmacGetDigest :: (MonadIO m) => Hmac -> -- _obj Word8 -> -- buffer Word64 -> -- digest_len m () hmacGetDigest _obj buffer digest_len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_hmac_get_digest _obj' buffer digest_len touchManagedPtr _obj return () -- method Hmac::get_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Hmac", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Hmac", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_hmac_get_string" g_hmac_get_string :: Ptr Hmac -> -- _obj : TInterface "GLib" "Hmac" IO CString hmacGetString :: (MonadIO m) => Hmac -> -- _obj m T.Text hmacGetString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_hmac_get_string _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method Hmac::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Hmac", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Hmac", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hmac_unref" g_hmac_unref :: Ptr Hmac -> -- _obj : TInterface "GLib" "Hmac" IO () hmacUnref :: (MonadIO m) => Hmac -> -- _obj m () hmacUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_hmac_unref _obj' touchManagedPtr _obj return () -- method Hmac::update -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Hmac", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Hmac", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hmac_update" g_hmac_update :: Ptr Hmac -> -- _obj : TInterface "GLib" "Hmac" Ptr Word8 -> -- data : TCArray False (-1) 2 (TBasicType TUInt8) Int64 -> -- length : TBasicType TInt64 IO () hmacUpdate :: (MonadIO m) => Hmac -> -- _obj ByteString -> -- data m () hmacUpdate _obj data_ = liftIO $ do let length_ = fromIntegral $ B.length data_ let _obj' = unsafeManagedPtrGetPtr _obj data_' <- packByteString data_ g_hmac_update _obj' data_' length_ touchManagedPtr _obj freeMem data_' return () -- struct Hook newtype Hook = Hook (ForeignPtr Hook) noHook :: Maybe Hook noHook = Nothing hookReadData :: Hook -> IO (Ptr ()) hookReadData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val hookReadNext :: Hook -> IO Hook hookReadNext s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr Hook) val' <- (newPtr 64 Hook) val return val' hookReadPrev :: Hook -> IO Hook hookReadPrev s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Hook) val' <- (newPtr 64 Hook) val return val' hookReadRefCount :: Hook -> IO Word32 hookReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Word32 return val hookReadHookId :: Hook -> IO Word64 hookReadHookId s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO Word64 return val hookReadFlags :: Hook -> IO Word32 hookReadFlags s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO Word32 return val hookReadFunc :: Hook -> IO (Ptr ()) hookReadFunc s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO (Ptr ()) return val -- XXX Skipped getter for "Hook:destroy" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- method Hook::compare_ids -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sibling", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sibling", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_hook_compare_ids" g_hook_compare_ids :: Ptr Hook -> -- _obj : TInterface "GLib" "Hook" Ptr Hook -> -- sibling : TInterface "GLib" "Hook" IO Int32 hookCompareIds :: (MonadIO m) => Hook -> -- _obj Hook -> -- sibling m Int32 hookCompareIds _obj sibling = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let sibling' = unsafeManagedPtrGetPtr sibling result <- g_hook_compare_ids _obj' sibling' touchManagedPtr _obj touchManagedPtr sibling return result -- callback HookCheckFunc hookCheckFuncClosure :: HookCheckFunc -> IO Closure hookCheckFuncClosure cb = newCClosure =<< mkHookCheckFunc wrapped where wrapped = hookCheckFuncWrapper Nothing cb type HookCheckFuncC = Ptr () -> IO CInt foreign import ccall "wrapper" mkHookCheckFunc :: HookCheckFuncC -> IO (FunPtr HookCheckFuncC) type HookCheckFunc = Ptr () -> IO Bool noHookCheckFunc :: Maybe HookCheckFunc noHookCheckFunc = Nothing hookCheckFuncWrapper :: Maybe (Ptr (FunPtr (HookCheckFuncC))) -> HookCheckFunc -> Ptr () -> IO CInt hookCheckFuncWrapper funptrptr _cb data_ = do result <- _cb data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback HookCheckMarshaller hookCheckMarshallerClosure :: HookCheckMarshaller -> IO Closure hookCheckMarshallerClosure cb = newCClosure =<< mkHookCheckMarshaller wrapped where wrapped = hookCheckMarshallerWrapper Nothing cb type HookCheckMarshallerC = Ptr Hook -> Ptr () -> IO CInt foreign import ccall "wrapper" mkHookCheckMarshaller :: HookCheckMarshallerC -> IO (FunPtr HookCheckMarshallerC) type HookCheckMarshaller = Hook -> Ptr () -> IO Bool noHookCheckMarshaller :: Maybe HookCheckMarshaller noHookCheckMarshaller = Nothing hookCheckMarshallerWrapper :: Maybe (Ptr (FunPtr (HookCheckMarshallerC))) -> HookCheckMarshaller -> Ptr Hook -> Ptr () -> IO CInt hookCheckMarshallerWrapper funptrptr _cb hook marshal_data = do hook' <- (newPtr 64 Hook) hook result <- _cb hook' marshal_data maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback HookCompareFunc hookCompareFuncClosure :: HookCompareFunc -> IO Closure hookCompareFuncClosure cb = newCClosure =<< mkHookCompareFunc wrapped where wrapped = hookCompareFuncWrapper Nothing cb type HookCompareFuncC = Ptr Hook -> Ptr Hook -> IO Int32 foreign import ccall "wrapper" mkHookCompareFunc :: HookCompareFuncC -> IO (FunPtr HookCompareFuncC) type HookCompareFunc = Hook -> Hook -> IO Int32 noHookCompareFunc :: Maybe HookCompareFunc noHookCompareFunc = Nothing hookCompareFuncWrapper :: Maybe (Ptr (FunPtr (HookCompareFuncC))) -> HookCompareFunc -> Ptr Hook -> Ptr Hook -> IO Int32 hookCompareFuncWrapper funptrptr _cb new_hook sibling = do new_hook' <- (newPtr 64 Hook) new_hook sibling' <- (newPtr 64 Hook) sibling result <- _cb new_hook' sibling' maybeReleaseFunPtr funptrptr return result -- callback HookFinalizeFunc hookFinalizeFuncClosure :: HookFinalizeFunc -> IO Closure hookFinalizeFuncClosure cb = newCClosure =<< mkHookFinalizeFunc wrapped where wrapped = hookFinalizeFuncWrapper Nothing cb type HookFinalizeFuncC = Ptr HookList -> Ptr Hook -> IO () foreign import ccall "wrapper" mkHookFinalizeFunc :: HookFinalizeFuncC -> IO (FunPtr HookFinalizeFuncC) type HookFinalizeFunc = HookList -> Hook -> IO () noHookFinalizeFunc :: Maybe HookFinalizeFunc noHookFinalizeFunc = Nothing hookFinalizeFuncWrapper :: Maybe (Ptr (FunPtr (HookFinalizeFuncC))) -> HookFinalizeFunc -> Ptr HookList -> Ptr Hook -> IO () hookFinalizeFuncWrapper funptrptr _cb hook_list hook = do hook_list' <- (newPtr 56 HookList) hook_list hook' <- (newPtr 64 Hook) hook _cb hook_list' hook' maybeReleaseFunPtr funptrptr -- callback HookFindFunc hookFindFuncClosure :: HookFindFunc -> IO Closure hookFindFuncClosure cb = newCClosure =<< mkHookFindFunc wrapped where wrapped = hookFindFuncWrapper Nothing cb type HookFindFuncC = Ptr Hook -> Ptr () -> IO CInt foreign import ccall "wrapper" mkHookFindFunc :: HookFindFuncC -> IO (FunPtr HookFindFuncC) type HookFindFunc = Hook -> Ptr () -> IO Bool noHookFindFunc :: Maybe HookFindFunc noHookFindFunc = Nothing hookFindFuncWrapper :: Maybe (Ptr (FunPtr (HookFindFuncC))) -> HookFindFunc -> Ptr Hook -> Ptr () -> IO CInt hookFindFuncWrapper funptrptr _cb hook data_ = do hook' <- (newPtr 64 Hook) hook result <- _cb hook' data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Flags HookFlagMask data HookFlagMask = HookFlagMaskActive | HookFlagMaskInCall | HookFlagMaskMask | AnotherHookFlagMask Int deriving (Show, Eq) instance Enum HookFlagMask where fromEnum HookFlagMaskActive = 1 fromEnum HookFlagMaskInCall = 2 fromEnum HookFlagMaskMask = 15 fromEnum (AnotherHookFlagMask k) = k toEnum 1 = HookFlagMaskActive toEnum 2 = HookFlagMaskInCall toEnum 15 = HookFlagMaskMask toEnum k = AnotherHookFlagMask k instance IsGFlag HookFlagMask -- callback HookFunc hookFuncClosure :: HookFunc -> IO Closure hookFuncClosure cb = newCClosure =<< mkHookFunc wrapped where wrapped = hookFuncWrapper Nothing cb type HookFuncC = Ptr () -> IO () foreign import ccall "wrapper" mkHookFunc :: HookFuncC -> IO (FunPtr HookFuncC) type HookFunc = Ptr () -> IO () noHookFunc :: Maybe HookFunc noHookFunc = Nothing hookFuncWrapper :: Maybe (Ptr (FunPtr (HookFuncC))) -> HookFunc -> Ptr () -> IO () hookFuncWrapper funptrptr _cb data_ = do _cb data_ maybeReleaseFunPtr funptrptr -- struct HookList newtype HookList = HookList (ForeignPtr HookList) noHookList :: Maybe HookList noHookList = Nothing hookListReadSeqId :: HookList -> IO Word64 hookListReadSeqId s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word64 return val hookListReadHookSize :: HookList -> IO Word32 hookListReadHookSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val hookListReadIsSetup :: HookList -> IO Word32 hookListReadIsSetup s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Word32 return val hookListReadHooks :: HookList -> IO Hook hookListReadHooks s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Hook) val' <- (newPtr 64 Hook) val return val' hookListReadDummy3 :: HookList -> IO (Ptr ()) hookListReadDummy3 s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr ()) return val -- XXX Skipped getter for "HookList:finalize_hook" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "HookList:dummy" :: Not implemented: "Don't know how to unpack C array of type TCArray False 2 (-1) (TBasicType TVoid)" -- method HookList::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hook_list_clear" g_hook_list_clear :: Ptr HookList -> -- _obj : TInterface "GLib" "HookList" IO () hookListClear :: (MonadIO m) => HookList -> -- _obj m () hookListClear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_hook_list_clear _obj' touchManagedPtr _obj return () -- method HookList::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook_size", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook_size", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hook_list_init" g_hook_list_init :: Ptr HookList -> -- _obj : TInterface "GLib" "HookList" Word32 -> -- hook_size : TBasicType TUInt32 IO () hookListInit :: (MonadIO m) => HookList -> -- _obj Word32 -> -- hook_size m () hookListInit _obj hook_size = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_hook_list_init _obj' hook_size touchManagedPtr _obj return () -- method HookList::invoke -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "may_recurse", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "may_recurse", 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_hook_list_invoke" g_hook_list_invoke :: Ptr HookList -> -- _obj : TInterface "GLib" "HookList" CInt -> -- may_recurse : TBasicType TBoolean IO () hookListInvoke :: (MonadIO m) => HookList -> -- _obj Bool -> -- may_recurse m () hookListInvoke _obj may_recurse = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let may_recurse' = (fromIntegral . fromEnum) may_recurse g_hook_list_invoke _obj' may_recurse' touchManagedPtr _obj return () -- method HookList::invoke_check -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "may_recurse", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "may_recurse", 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_hook_list_invoke_check" g_hook_list_invoke_check :: Ptr HookList -> -- _obj : TInterface "GLib" "HookList" CInt -> -- may_recurse : TBasicType TBoolean IO () hookListInvokeCheck :: (MonadIO m) => HookList -> -- _obj Bool -> -- may_recurse m () hookListInvokeCheck _obj may_recurse = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let may_recurse' = (fromIntegral . fromEnum) may_recurse g_hook_list_invoke_check _obj' may_recurse' touchManagedPtr _obj return () -- callback HookMarshaller hookMarshallerClosure :: HookMarshaller -> IO Closure hookMarshallerClosure cb = newCClosure =<< mkHookMarshaller wrapped where wrapped = hookMarshallerWrapper Nothing cb type HookMarshallerC = Ptr Hook -> Ptr () -> IO () foreign import ccall "wrapper" mkHookMarshaller :: HookMarshallerC -> IO (FunPtr HookMarshallerC) type HookMarshaller = Hook -> Ptr () -> IO () noHookMarshaller :: Maybe HookMarshaller noHookMarshaller = Nothing hookMarshallerWrapper :: Maybe (Ptr (FunPtr (HookMarshallerC))) -> HookMarshaller -> Ptr Hook -> Ptr () -> IO () hookMarshallerWrapper funptrptr _cb hook marshal_data = do hook' <- (newPtr 64 Hook) hook _cb hook' marshal_data maybeReleaseFunPtr funptrptr -- struct IConv newtype IConv = IConv (ForeignPtr IConv) noIConv :: Maybe IConv noIConv = Nothing -- method IConv::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "IConv", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "IConv", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_iconv_close" g_iconv_close :: Ptr IConv -> -- _obj : TInterface "GLib" "IConv" IO Int32 iConvClose :: (MonadIO m) => IConv -> -- _obj m Int32 iConvClose _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_iconv_close _obj' touchManagedPtr _obj return result -- struct IOChannel newtype IOChannel = IOChannel (ForeignPtr IOChannel) noIOChannel :: Maybe IOChannel noIOChannel = Nothing 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 -- 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' 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 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' 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_ 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' 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 () ) -- Enum IOChannelError data IOChannelError = IOChannelErrorFbig | IOChannelErrorInval | IOChannelErrorIo | IOChannelErrorIsdir | IOChannelErrorNospc | IOChannelErrorNxio | IOChannelErrorOverflow | IOChannelErrorPipe | IOChannelErrorFailed | AnotherIOChannelError Int deriving (Show, Eq) instance Enum IOChannelError where fromEnum IOChannelErrorFbig = 0 fromEnum IOChannelErrorInval = 1 fromEnum IOChannelErrorIo = 2 fromEnum IOChannelErrorIsdir = 3 fromEnum IOChannelErrorNospc = 4 fromEnum IOChannelErrorNxio = 5 fromEnum IOChannelErrorOverflow = 6 fromEnum IOChannelErrorPipe = 7 fromEnum IOChannelErrorFailed = 8 fromEnum (AnotherIOChannelError k) = k toEnum 0 = IOChannelErrorFbig toEnum 1 = IOChannelErrorInval toEnum 2 = IOChannelErrorIo toEnum 3 = IOChannelErrorIsdir toEnum 4 = IOChannelErrorNospc toEnum 5 = IOChannelErrorNxio toEnum 6 = IOChannelErrorOverflow toEnum 7 = IOChannelErrorPipe toEnum 8 = IOChannelErrorFailed toEnum k = AnotherIOChannelError k instance GErrorClass IOChannelError where gerrorClassDomain _ = "g-io-channel-error-quark" catchIOChannelError :: IO a -> (IOChannelError -> GErrorMessage -> IO a) -> IO a catchIOChannelError = catchGErrorJustDomain handleIOChannelError :: (IOChannelError -> GErrorMessage -> IO a) -> IO a -> IO a handleIOChannelError = handleGErrorJustDomain -- Flags IOCondition data IOCondition = IOConditionIn | IOConditionOut | IOConditionPri | IOConditionErr | IOConditionHup | IOConditionNval | AnotherIOCondition Int deriving (Show, Eq) instance Enum IOCondition where fromEnum IOConditionIn = 1 fromEnum IOConditionOut = 4 fromEnum IOConditionPri = 2 fromEnum IOConditionErr = 8 fromEnum IOConditionHup = 16 fromEnum IOConditionNval = 32 fromEnum (AnotherIOCondition k) = k toEnum 1 = IOConditionIn toEnum 2 = IOConditionPri toEnum 4 = IOConditionOut toEnum 8 = IOConditionErr toEnum 16 = IOConditionHup toEnum 32 = IOConditionNval toEnum k = AnotherIOCondition k foreign import ccall "g_io_condition_get_type" c_g_io_condition_get_type :: IO GType instance BoxedEnum IOCondition where boxedEnumType _ = c_g_io_condition_get_type instance IsGFlag IOCondition -- Enum IOError data IOError = IOErrorNone | IOErrorAgain | IOErrorInval | IOErrorUnknown | AnotherIOError Int deriving (Show, Eq) instance Enum IOError where fromEnum IOErrorNone = 0 fromEnum IOErrorAgain = 1 fromEnum IOErrorInval = 2 fromEnum IOErrorUnknown = 3 fromEnum (AnotherIOError k) = k toEnum 0 = IOErrorNone toEnum 1 = IOErrorAgain toEnum 2 = IOErrorInval toEnum 3 = IOErrorUnknown toEnum k = AnotherIOError k -- Flags IOFlags data IOFlags = IOFlagsAppend | IOFlagsNonblock | IOFlagsIsReadable | IOFlagsIsWritable | IOFlagsIsWriteable | IOFlagsIsSeekable | IOFlagsMask | IOFlagsGetMask | IOFlagsSetMask | AnotherIOFlags Int deriving (Show, Eq) instance Enum IOFlags where fromEnum IOFlagsAppend = 1 fromEnum IOFlagsNonblock = 2 fromEnum IOFlagsIsReadable = 4 fromEnum IOFlagsIsWritable = 8 fromEnum IOFlagsIsWriteable = 8 fromEnum IOFlagsIsSeekable = 16 fromEnum IOFlagsMask = 31 fromEnum IOFlagsGetMask = 31 fromEnum IOFlagsSetMask = 3 fromEnum (AnotherIOFlags k) = k toEnum 1 = IOFlagsAppend toEnum 2 = IOFlagsNonblock toEnum 3 = IOFlagsSetMask toEnum 4 = IOFlagsIsReadable toEnum 8 = IOFlagsIsWritable toEnum 16 = IOFlagsIsSeekable toEnum 31 = IOFlagsMask toEnum k = AnotherIOFlags k instance IsGFlag IOFlags -- callback IOFunc iOFuncClosure :: IOFunc -> IO Closure iOFuncClosure cb = newCClosure =<< mkIOFunc wrapped where wrapped = iOFuncWrapper Nothing cb type IOFuncC = Ptr IOChannel -> CUInt -> Ptr () -> IO CInt foreign import ccall "wrapper" mkIOFunc :: IOFuncC -> IO (FunPtr IOFuncC) type IOFunc = IOChannel -> [IOCondition] -> Ptr () -> IO Bool noIOFunc :: Maybe IOFunc noIOFunc = Nothing iOFuncWrapper :: Maybe (Ptr (FunPtr (IOFuncC))) -> IOFunc -> Ptr IOChannel -> CUInt -> Ptr () -> IO CInt iOFuncWrapper funptrptr _cb source condition data_ = do source' <- (newBoxed IOChannel) source let condition' = wordToGFlags condition result <- _cb source' condition' data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- struct IOFuncs newtype IOFuncs = IOFuncs (ForeignPtr IOFuncs) noIOFuncs :: Maybe IOFuncs noIOFuncs = Nothing -- XXX Skipped getter for "IOFuncs:io_read" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IOFuncs:io_write" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IOFuncs:io_seek" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IOFuncs:io_close" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IOFuncs:io_create_watch" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IOFuncs:io_free" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IOFuncs:io_set_flags" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IOFuncs:io_get_flags" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- Enum IOStatus data IOStatus = IOStatusError | IOStatusNormal | IOStatusEof | IOStatusAgain | AnotherIOStatus Int deriving (Show, Eq) instance Enum IOStatus where fromEnum IOStatusError = 0 fromEnum IOStatusNormal = 1 fromEnum IOStatusEof = 2 fromEnum IOStatusAgain = 3 fromEnum (AnotherIOStatus k) = k toEnum 0 = IOStatusError toEnum 1 = IOStatusNormal toEnum 2 = IOStatusEof toEnum 3 = IOStatusAgain toEnum k = AnotherIOStatus k -- struct KeyFile newtype KeyFile = KeyFile (ForeignPtr KeyFile) noKeyFile :: Maybe KeyFile noKeyFile = Nothing foreign import ccall "g_key_file_get_type" c_g_key_file_get_type :: IO GType instance BoxedObject KeyFile where boxedType _ = c_g_key_file_get_type -- method KeyFile::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "KeyFile" -- throws : False -- Skip return : False foreign import ccall "g_key_file_new" g_key_file_new :: IO (Ptr KeyFile) keyFileNew :: (MonadIO m) => m KeyFile keyFileNew = liftIO $ do result <- g_key_file_new result' <- (wrapBoxed KeyFile) result return result' -- method KeyFile::get_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_boolean" g_key_file_get_boolean :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt keyFileGetBoolean :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m () keyFileGetBoolean _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key onException (do _ <- propagateGError $ g_key_file_get_boolean _obj' group_name' key' touchManagedPtr _obj freeMem group_name' freeMem key' return () ) (do freeMem group_name' freeMem key' ) -- method KeyFile::get_boolean_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},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" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 3 (TBasicType TBoolean) -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_boolean_list" g_key_file_get_boolean_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr CInt) keyFileGetBooleanList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m [Bool] keyFileGetBooleanList _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_key_file_get_boolean_list _obj' group_name' key' length_ length_' <- peek length_ result' <- (unpackMapStorableArrayWithLength (/= 0) length_') result freeMem result touchManagedPtr _obj freeMem group_name' freeMem key' freeMem length_ return result' ) (do freeMem group_name' freeMem key' freeMem length_ ) -- method KeyFile::get_comment -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_comment" g_key_file_get_comment :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString keyFileGetComment :: (MonadIO m) => KeyFile -> -- _obj Maybe (T.Text) -> -- group_name T.Text -> -- key m T.Text keyFileGetComment _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeGroup_name <- case group_name of Nothing -> return nullPtr Just jGroup_name -> do jGroup_name' <- textToCString jGroup_name return jGroup_name' key' <- textToCString key onException (do result <- propagateGError $ g_key_file_get_comment _obj' maybeGroup_name key' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem maybeGroup_name freeMem key' return result' ) (do freeMem maybeGroup_name freeMem key' ) -- method KeyFile::get_double -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_double" g_key_file_get_double :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CDouble keyFileGetDouble :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m Double keyFileGetDouble _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key onException (do result <- propagateGError $ g_key_file_get_double _obj' group_name' key' let result' = realToFrac result touchManagedPtr _obj freeMem group_name' freeMem key' return result' ) (do freeMem group_name' freeMem key' ) -- method KeyFile::get_double_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},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" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 3 (TBasicType TDouble) -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_double_list" g_key_file_get_double_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr CDouble) keyFileGetDoubleList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m [Double] keyFileGetDoubleList _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_key_file_get_double_list _obj' group_name' key' length_ length_' <- peek length_ result' <- (unpackMapStorableArrayWithLength realToFrac length_') result freeMem result touchManagedPtr _obj freeMem group_name' freeMem key' freeMem length_ return result' ) (do freeMem group_name' freeMem key' freeMem length_ ) -- method KeyFile::get_groups -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_key_file_get_groups" g_key_file_get_groups :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" Ptr Word64 -> -- length : TBasicType TUInt64 IO (Ptr CString) keyFileGetGroups :: (MonadIO m) => KeyFile -> -- _obj m ([T.Text],Word64) keyFileGetGroups _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj length_ <- allocMem :: IO (Ptr Word64) result <- g_key_file_get_groups _obj' length_ result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result length_' <- peek length_ touchManagedPtr _obj freeMem length_ return (result', length_') -- method KeyFile::get_int64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_int64" g_key_file_get_int64 :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO Int64 keyFileGetInt64 :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m Int64 keyFileGetInt64 _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key onException (do result <- propagateGError $ g_key_file_get_int64 _obj' group_name' key' touchManagedPtr _obj freeMem group_name' freeMem key' return result ) (do freeMem group_name' freeMem key' ) -- method KeyFile::get_integer -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_integer" g_key_file_get_integer :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO Int32 keyFileGetInteger :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m Int32 keyFileGetInteger _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key onException (do result <- propagateGError $ g_key_file_get_integer _obj' group_name' key' touchManagedPtr _obj freeMem group_name' freeMem key' return result ) (do freeMem group_name' freeMem key' ) -- method KeyFile::get_integer_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},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" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 3 (TBasicType TInt32) -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_integer_list" g_key_file_get_integer_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr Int32) keyFileGetIntegerList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m [Int32] keyFileGetIntegerList _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_key_file_get_integer_list _obj' group_name' key' length_ length_' <- peek length_ result' <- (unpackStorableArrayWithLength length_') result freeMem result touchManagedPtr _obj freeMem group_name' freeMem key' freeMem length_ return result' ) (do freeMem group_name' freeMem key' freeMem length_ ) -- method KeyFile::get_keys -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_keys" g_key_file_get_keys :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr CString) keyFileGetKeys :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name m ([T.Text],Word64) keyFileGetKeys _obj group_name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_key_file_get_keys _obj' group_name' length_ result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result length_' <- peek length_ touchManagedPtr _obj freeMem group_name' freeMem length_ return (result', length_') ) (do freeMem group_name' freeMem length_ ) -- method KeyFile::get_locale_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_locale_string" g_key_file_get_locale_string :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CString -> -- locale : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString keyFileGetLocaleString :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key Maybe (T.Text) -> -- locale m T.Text keyFileGetLocaleString _obj group_name key locale = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key maybeLocale <- case locale of Nothing -> return nullPtr Just jLocale -> do jLocale' <- textToCString jLocale return jLocale' onException (do result <- propagateGError $ g_key_file_get_locale_string _obj' group_name' key' maybeLocale result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem group_name' freeMem key' freeMem maybeLocale return result' ) (do freeMem group_name' freeMem key' freeMem maybeLocale ) -- method KeyFile::get_locale_string_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) 4 (TBasicType TUTF8) -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_locale_string_list" g_key_file_get_locale_string_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CString -> -- locale : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr CString) keyFileGetLocaleStringList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key Maybe (T.Text) -> -- locale m ([T.Text],Word64) keyFileGetLocaleStringList _obj group_name key locale = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key maybeLocale <- case locale of Nothing -> return nullPtr Just jLocale -> do jLocale' <- textToCString jLocale return jLocale' length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_key_file_get_locale_string_list _obj' group_name' key' maybeLocale length_ result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result length_' <- peek length_ touchManagedPtr _obj freeMem group_name' freeMem key' freeMem maybeLocale freeMem length_ return (result', length_') ) (do freeMem group_name' freeMem key' freeMem maybeLocale freeMem length_ ) -- method KeyFile::get_start_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_key_file_get_start_group" g_key_file_get_start_group :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" IO CString keyFileGetStartGroup :: (MonadIO m) => KeyFile -> -- _obj m T.Text keyFileGetStartGroup _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_key_file_get_start_group _obj' result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method KeyFile::get_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_string" g_key_file_get_string :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString keyFileGetString :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m T.Text keyFileGetString _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key onException (do result <- propagateGError $ g_key_file_get_string _obj' group_name' key' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem group_name' freeMem key' return result' ) (do freeMem group_name' freeMem key' ) -- method KeyFile::get_string_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) 3 (TBasicType TUTF8) -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_string_list" g_key_file_get_string_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr CString) keyFileGetStringList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m ([T.Text],Word64) keyFileGetStringList _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_key_file_get_string_list _obj' group_name' key' length_ result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result length_' <- peek length_ touchManagedPtr _obj freeMem group_name' freeMem key' freeMem length_ return (result', length_') ) (do freeMem group_name' freeMem key' freeMem length_ ) -- method KeyFile::get_uint64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_uint64" g_key_file_get_uint64 :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO Word64 keyFileGetUint64 :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m Word64 keyFileGetUint64 _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key onException (do result <- propagateGError $ g_key_file_get_uint64 _obj' group_name' key' touchManagedPtr _obj freeMem group_name' freeMem key' return result ) (do freeMem group_name' freeMem key' ) -- method KeyFile::get_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_key_file_get_value" g_key_file_get_value :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString keyFileGetValue :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m T.Text keyFileGetValue _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key onException (do result <- propagateGError $ g_key_file_get_value _obj' group_name' key' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem group_name' freeMem key' return result' ) (do freeMem group_name' freeMem key' ) -- method KeyFile::has_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_key_file_has_group" g_key_file_has_group :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 IO CInt keyFileHasGroup :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name m Bool keyFileHasGroup _obj group_name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name result <- g_key_file_has_group _obj' group_name' let result' = (/= 0) result touchManagedPtr _obj freeMem group_name' return result' -- method KeyFile::load_from_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "KeyFileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "KeyFileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_load_from_data" g_key_file_load_from_data :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- data : TBasicType TUTF8 Word64 -> -- length : TBasicType TUInt64 CUInt -> -- flags : TInterface "GLib" "KeyFileFlags" Ptr (Ptr GError) -> -- error IO CInt keyFileLoadFromData :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- data Word64 -> -- length [KeyFileFlags] -> -- flags m () keyFileLoadFromData _obj data_ length_ flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj data_' <- textToCString data_ let flags' = gflagsToWord flags onException (do _ <- propagateGError $ g_key_file_load_from_data _obj' data_' length_ flags' touchManagedPtr _obj freeMem data_' return () ) (do freeMem data_' ) -- method KeyFile::load_from_data_dirs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "full_path", argType = TBasicType TFileName, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "flags", argType = TInterface "GLib" "KeyFileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "KeyFileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_load_from_data_dirs" g_key_file_load_from_data_dirs :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- file : TBasicType TFileName Ptr CString -> -- full_path : TBasicType TFileName CUInt -> -- flags : TInterface "GLib" "KeyFileFlags" Ptr (Ptr GError) -> -- error IO CInt keyFileLoadFromDataDirs :: (MonadIO m) => KeyFile -> -- _obj [Char] -> -- file [KeyFileFlags] -> -- flags m ([Char]) keyFileLoadFromDataDirs _obj file flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj file' <- stringToCString file full_path <- allocMem :: IO (Ptr CString) let flags' = gflagsToWord flags onException (do _ <- propagateGError $ g_key_file_load_from_data_dirs _obj' file' full_path flags' full_path' <- peek full_path full_path'' <- cstringToString full_path' freeMem full_path' touchManagedPtr _obj freeMem file' freeMem full_path return full_path'' ) (do freeMem file' freeMem full_path ) -- method KeyFile::load_from_dirs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "search_dirs", argType = TCArray True (-1) (-1) (TBasicType TFileName), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "full_path", argType = TBasicType TFileName, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "flags", argType = TInterface "GLib" "KeyFileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "search_dirs", argType = TCArray True (-1) (-1) (TBasicType TFileName), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "KeyFileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_load_from_dirs" g_key_file_load_from_dirs :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- file : TBasicType TFileName Ptr CString -> -- search_dirs : TCArray True (-1) (-1) (TBasicType TFileName) Ptr CString -> -- full_path : TBasicType TFileName CUInt -> -- flags : TInterface "GLib" "KeyFileFlags" Ptr (Ptr GError) -> -- error IO CInt keyFileLoadFromDirs :: (MonadIO m) => KeyFile -> -- _obj [Char] -> -- file [[Char]] -> -- search_dirs [KeyFileFlags] -> -- flags m ([Char]) keyFileLoadFromDirs _obj file search_dirs flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj file' <- stringToCString file search_dirs' <- packZeroTerminatedFileNameArray search_dirs full_path <- allocMem :: IO (Ptr CString) let flags' = gflagsToWord flags onException (do _ <- propagateGError $ g_key_file_load_from_dirs _obj' file' search_dirs' full_path flags' full_path' <- peek full_path full_path'' <- cstringToString full_path' freeMem full_path' touchManagedPtr _obj freeMem file' mapZeroTerminatedCArray freeMem search_dirs' freeMem search_dirs' freeMem full_path return full_path'' ) (do freeMem file' mapZeroTerminatedCArray freeMem search_dirs' freeMem search_dirs' freeMem full_path ) -- method KeyFile::load_from_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "KeyFileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "KeyFileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_load_from_file" g_key_file_load_from_file :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- file : TBasicType TFileName CUInt -> -- flags : TInterface "GLib" "KeyFileFlags" Ptr (Ptr GError) -> -- error IO CInt keyFileLoadFromFile :: (MonadIO m) => KeyFile -> -- _obj [Char] -> -- file [KeyFileFlags] -> -- flags m () keyFileLoadFromFile _obj file flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj file' <- stringToCString file let flags' = gflagsToWord flags onException (do _ <- propagateGError $ g_key_file_load_from_file _obj' file' flags' touchManagedPtr _obj freeMem file' return () ) (do freeMem file' ) -- method KeyFile::remove_comment -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_remove_comment" g_key_file_remove_comment :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt keyFileRemoveComment :: (MonadIO m) => KeyFile -> -- _obj Maybe (T.Text) -> -- group_name Maybe (T.Text) -> -- key m () keyFileRemoveComment _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeGroup_name <- case group_name of Nothing -> return nullPtr Just jGroup_name -> do jGroup_name' <- textToCString jGroup_name return jGroup_name' maybeKey <- case key of Nothing -> return nullPtr Just jKey -> do jKey' <- textToCString jKey return jKey' onException (do _ <- propagateGError $ g_key_file_remove_comment _obj' maybeGroup_name maybeKey touchManagedPtr _obj freeMem maybeGroup_name freeMem maybeKey return () ) (do freeMem maybeGroup_name freeMem maybeKey ) -- method KeyFile::remove_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_remove_group" g_key_file_remove_group :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt keyFileRemoveGroup :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name m () keyFileRemoveGroup _obj group_name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name onException (do _ <- propagateGError $ g_key_file_remove_group _obj' group_name' touchManagedPtr _obj freeMem group_name' return () ) (do freeMem group_name' ) -- method KeyFile::remove_key -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_remove_key" g_key_file_remove_key :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt keyFileRemoveKey :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key m () keyFileRemoveKey _obj group_name key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key onException (do _ <- propagateGError $ g_key_file_remove_key _obj' group_name' key' touchManagedPtr _obj freeMem group_name' freeMem key' return () ) (do freeMem group_name' freeMem key' ) -- method KeyFile::save_to_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_save_to_file" g_key_file_save_to_file :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- filename : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt keyFileSaveToFile :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- filename m () keyFileSaveToFile _obj filename = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj filename' <- textToCString filename onException (do _ <- propagateGError $ g_key_file_save_to_file _obj' filename' touchManagedPtr _obj freeMem filename' return () ) (do freeMem filename' ) -- method KeyFile::set_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", 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_key_file_set_boolean" g_key_file_set_boolean :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CInt -> -- value : TBasicType TBoolean IO () keyFileSetBoolean :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key Bool -> -- value m () keyFileSetBoolean _obj group_name key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key let value' = (fromIntegral . fromEnum) value g_key_file_set_boolean _obj' group_name' key' value' touchManagedPtr _obj freeMem group_name' freeMem key' return () -- method KeyFile::set_boolean_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray False (-1) 4 (TBasicType TBoolean), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray False (-1) 4 (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_key_file_set_boolean_list" g_key_file_set_boolean_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr CInt -> -- list : TCArray False (-1) 4 (TBasicType TBoolean) Word64 -> -- length : TBasicType TUInt64 IO () keyFileSetBooleanList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key [Bool] -> -- list m () keyFileSetBooleanList _obj group_name key list = liftIO $ do let length_ = fromIntegral $ length list let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key list' <- (packMapStorableArray (fromIntegral . fromEnum)) list g_key_file_set_boolean_list _obj' group_name' key' list' length_ touchManagedPtr _obj freeMem group_name' freeMem key' freeMem list' return () -- method KeyFile::set_comment -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "comment", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "comment", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_key_file_set_comment" g_key_file_set_comment :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CString -> -- comment : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt keyFileSetComment :: (MonadIO m) => KeyFile -> -- _obj Maybe (T.Text) -> -- group_name Maybe (T.Text) -> -- key T.Text -> -- comment m () keyFileSetComment _obj group_name key comment = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeGroup_name <- case group_name of Nothing -> return nullPtr Just jGroup_name -> do jGroup_name' <- textToCString jGroup_name return jGroup_name' maybeKey <- case key of Nothing -> return nullPtr Just jKey -> do jKey' <- textToCString jKey return jKey' comment' <- textToCString comment onException (do _ <- propagateGError $ g_key_file_set_comment _obj' maybeGroup_name maybeKey comment' touchManagedPtr _obj freeMem maybeGroup_name freeMem maybeKey freeMem comment' return () ) (do freeMem maybeGroup_name freeMem maybeKey freeMem comment' ) -- method KeyFile::set_double -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_key_file_set_double" g_key_file_set_double :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CDouble -> -- value : TBasicType TDouble IO () keyFileSetDouble :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key Double -> -- value m () keyFileSetDouble _obj group_name key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key let value' = realToFrac value g_key_file_set_double _obj' group_name' key' value' touchManagedPtr _obj freeMem group_name' freeMem key' return () -- method KeyFile::set_double_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray False (-1) 4 (TBasicType TDouble), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray False (-1) 4 (TBasicType TDouble), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_key_file_set_double_list" g_key_file_set_double_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr CDouble -> -- list : TCArray False (-1) 4 (TBasicType TDouble) Word64 -> -- length : TBasicType TUInt64 IO () keyFileSetDoubleList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key [Double] -> -- list m () keyFileSetDoubleList _obj group_name key list = liftIO $ do let length_ = fromIntegral $ length list let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key list' <- (packMapStorableArray realToFrac) list g_key_file_set_double_list _obj' group_name' key' list' length_ touchManagedPtr _obj freeMem group_name' freeMem key' freeMem list' return () -- method KeyFile::set_int64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_key_file_set_int64" g_key_file_set_int64 :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Int64 -> -- value : TBasicType TInt64 IO () keyFileSetInt64 :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key Int64 -> -- value m () keyFileSetInt64 _obj group_name key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key g_key_file_set_int64 _obj' group_name' key' value touchManagedPtr _obj freeMem group_name' freeMem key' return () -- method KeyFile::set_integer -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", 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_key_file_set_integer" g_key_file_set_integer :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Int32 -> -- value : TBasicType TInt32 IO () keyFileSetInteger :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key Int32 -> -- value m () keyFileSetInteger _obj group_name key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key g_key_file_set_integer _obj' group_name' key' value touchManagedPtr _obj freeMem group_name' freeMem key' return () -- method KeyFile::set_integer_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray False (-1) 4 (TBasicType TInt32), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray False (-1) 4 (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_key_file_set_integer_list" g_key_file_set_integer_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr Int32 -> -- list : TCArray False (-1) 4 (TBasicType TInt32) Word64 -> -- length : TBasicType TUInt64 IO () keyFileSetIntegerList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key [Int32] -> -- list m () keyFileSetIntegerList _obj group_name key list = liftIO $ do let length_ = fromIntegral $ length list let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key list' <- packStorableArray list g_key_file_set_integer_list _obj' group_name' key' list' length_ touchManagedPtr _obj freeMem group_name' freeMem key' freeMem list' return () -- method KeyFile::set_list_separator -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "separator", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "separator", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_key_file_set_list_separator" g_key_file_set_list_separator :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" Int8 -> -- separator : TBasicType TInt8 IO () keyFileSetListSeparator :: (MonadIO m) => KeyFile -> -- _obj Int8 -> -- separator m () keyFileSetListSeparator _obj separator = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_key_file_set_list_separator _obj' separator touchManagedPtr _obj return () -- method KeyFile::set_locale_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_key_file_set_locale_string" g_key_file_set_locale_string :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CString -> -- locale : TBasicType TUTF8 CString -> -- string : TBasicType TUTF8 IO () keyFileSetLocaleString :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key T.Text -> -- locale T.Text -> -- string m () keyFileSetLocaleString _obj group_name key locale string = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key locale' <- textToCString locale string' <- textToCString string g_key_file_set_locale_string _obj' group_name' key' locale' string' touchManagedPtr _obj freeMem group_name' freeMem key' freeMem locale' freeMem string' return () -- method KeyFile::set_locale_string_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray True (-1) 5 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray True (-1) 5 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", 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_key_file_set_locale_string_list" g_key_file_set_locale_string_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CString -> -- locale : TBasicType TUTF8 Ptr CString -> -- list : TCArray True (-1) 5 (TBasicType TUTF8) Word64 -> -- length : TBasicType TUInt64 IO () keyFileSetLocaleStringList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key T.Text -> -- locale [T.Text] -> -- list Word64 -> -- length m () keyFileSetLocaleStringList _obj group_name key locale list length_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key locale' <- textToCString locale list' <- packZeroTerminatedUTF8CArray list g_key_file_set_locale_string_list _obj' group_name' key' locale' list' length_ touchManagedPtr _obj freeMem group_name' freeMem key' freeMem locale' mapZeroTerminatedCArray freeMem list' freeMem list' return () -- method KeyFile::set_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_key_file_set_string" g_key_file_set_string :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CString -> -- string : TBasicType TUTF8 IO () keyFileSetString :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key T.Text -> -- string m () keyFileSetString _obj group_name key string = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key string' <- textToCString string g_key_file_set_string _obj' group_name' key' string' touchManagedPtr _obj freeMem group_name' freeMem key' freeMem string' return () -- method KeyFile::set_string_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray True (-1) 4 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TCArray True (-1) 4 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", 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_key_file_set_string_list" g_key_file_set_string_list :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Ptr CString -> -- list : TCArray True (-1) 4 (TBasicType TUTF8) Word64 -> -- length : TBasicType TUInt64 IO () keyFileSetStringList :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key [T.Text] -> -- list Word64 -> -- length m () keyFileSetStringList _obj group_name key list length_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key list' <- packZeroTerminatedUTF8CArray list g_key_file_set_string_list _obj' group_name' key' list' length_ touchManagedPtr _obj freeMem group_name' freeMem key' mapZeroTerminatedCArray freeMem list' freeMem list' return () -- method KeyFile::set_uint64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", 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_key_file_set_uint64" g_key_file_set_uint64 :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 Word64 -> -- value : TBasicType TUInt64 IO () keyFileSetUint64 :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key Word64 -> -- value m () keyFileSetUint64 _obj group_name key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key g_key_file_set_uint64 _obj' group_name' key' value touchManagedPtr _obj freeMem group_name' freeMem key' return () -- method KeyFile::set_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_key_file_set_value" g_key_file_set_value :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" CString -> -- group_name : TBasicType TUTF8 CString -> -- key : TBasicType TUTF8 CString -> -- value : TBasicType TUTF8 IO () keyFileSetValue :: (MonadIO m) => KeyFile -> -- _obj T.Text -> -- group_name T.Text -> -- key T.Text -> -- value m () keyFileSetValue _obj group_name key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group_name' <- textToCString group_name key' <- textToCString key value' <- textToCString value g_key_file_set_value _obj' group_name' key' value' touchManagedPtr _obj freeMem group_name' freeMem key' freeMem value' return () -- method KeyFile::to_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_key_file_to_data" g_key_file_to_data :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString keyFileToData :: (MonadIO m) => KeyFile -> -- _obj m (T.Text,Word64) keyFileToData _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_key_file_to_data _obj' length_ result' <- cstringToText result freeMem result length_' <- peek length_ touchManagedPtr _obj freeMem length_ return (result', length_') ) (do freeMem length_ ) -- method KeyFile::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_key_file_unref" g_key_file_unref :: Ptr KeyFile -> -- _obj : TInterface "GLib" "KeyFile" IO () keyFileUnref :: (MonadIO m) => KeyFile -> -- _obj m () keyFileUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_key_file_unref _obj' touchManagedPtr _obj return () -- Enum KeyFileError data KeyFileError = KeyFileErrorUnknownEncoding | KeyFileErrorParse | KeyFileErrorNotFound | KeyFileErrorKeyNotFound | KeyFileErrorGroupNotFound | KeyFileErrorInvalidValue | AnotherKeyFileError Int deriving (Show, Eq) instance Enum KeyFileError where fromEnum KeyFileErrorUnknownEncoding = 0 fromEnum KeyFileErrorParse = 1 fromEnum KeyFileErrorNotFound = 2 fromEnum KeyFileErrorKeyNotFound = 3 fromEnum KeyFileErrorGroupNotFound = 4 fromEnum KeyFileErrorInvalidValue = 5 fromEnum (AnotherKeyFileError k) = k toEnum 0 = KeyFileErrorUnknownEncoding toEnum 1 = KeyFileErrorParse toEnum 2 = KeyFileErrorNotFound toEnum 3 = KeyFileErrorKeyNotFound toEnum 4 = KeyFileErrorGroupNotFound toEnum 5 = KeyFileErrorInvalidValue toEnum k = AnotherKeyFileError k instance GErrorClass KeyFileError where gerrorClassDomain _ = "g-key-file-error-quark" catchKeyFileError :: IO a -> (KeyFileError -> GErrorMessage -> IO a) -> IO a catchKeyFileError = catchGErrorJustDomain handleKeyFileError :: (KeyFileError -> GErrorMessage -> IO a) -> IO a -> IO a handleKeyFileError = handleGErrorJustDomain -- Flags KeyFileFlags data KeyFileFlags = KeyFileFlagsNone | KeyFileFlagsKeepComments | KeyFileFlagsKeepTranslations | AnotherKeyFileFlags Int deriving (Show, Eq) instance Enum KeyFileFlags where fromEnum KeyFileFlagsNone = 0 fromEnum KeyFileFlagsKeepComments = 1 fromEnum KeyFileFlagsKeepTranslations = 2 fromEnum (AnotherKeyFileFlags k) = k toEnum 0 = KeyFileFlagsNone toEnum 1 = KeyFileFlagsKeepComments toEnum 2 = KeyFileFlagsKeepTranslations toEnum k = AnotherKeyFileFlags k instance IsGFlag KeyFileFlags -- callback LogFunc logFuncClosure :: LogFunc -> IO Closure logFuncClosure cb = newCClosure =<< mkLogFunc wrapped where wrapped = logFuncWrapper Nothing cb type LogFuncC = CString -> CUInt -> CString -> Ptr () -> IO () foreign import ccall "wrapper" mkLogFunc :: LogFuncC -> IO (FunPtr LogFuncC) type LogFunc = T.Text -> [LogLevelFlags] -> T.Text -> IO () noLogFunc :: Maybe LogFunc noLogFunc = Nothing logFuncWrapper :: Maybe (Ptr (FunPtr (LogFuncC))) -> LogFunc -> CString -> CUInt -> CString -> Ptr () -> IO () logFuncWrapper funptrptr _cb log_domain log_level message _ = do log_domain' <- cstringToText log_domain let log_level' = wordToGFlags log_level message' <- cstringToText message _cb log_domain' log_level' message' maybeReleaseFunPtr funptrptr -- Flags LogLevelFlags data LogLevelFlags = LogLevelFlagsFlagRecursion | LogLevelFlagsFlagFatal | LogLevelFlagsLevelError | LogLevelFlagsLevelCritical | LogLevelFlagsLevelWarning | LogLevelFlagsLevelMessage | LogLevelFlagsLevelInfo | LogLevelFlagsLevelDebug | LogLevelFlagsLevelMask | AnotherLogLevelFlags Int deriving (Show, Eq) instance Enum LogLevelFlags where fromEnum LogLevelFlagsFlagRecursion = 1 fromEnum LogLevelFlagsFlagFatal = 2 fromEnum LogLevelFlagsLevelError = 4 fromEnum LogLevelFlagsLevelCritical = 8 fromEnum LogLevelFlagsLevelWarning = 16 fromEnum LogLevelFlagsLevelMessage = 32 fromEnum LogLevelFlagsLevelInfo = 64 fromEnum LogLevelFlagsLevelDebug = 128 fromEnum LogLevelFlagsLevelMask = -4 fromEnum (AnotherLogLevelFlags k) = k toEnum -4 = LogLevelFlagsLevelMask toEnum 1 = LogLevelFlagsFlagRecursion toEnum 2 = LogLevelFlagsFlagFatal toEnum 4 = LogLevelFlagsLevelError toEnum 8 = LogLevelFlagsLevelCritical toEnum 16 = LogLevelFlagsLevelWarning toEnum 32 = LogLevelFlagsLevelMessage toEnum 64 = LogLevelFlagsLevelInfo toEnum 128 = LogLevelFlagsLevelDebug toEnum k = AnotherLogLevelFlags k instance IsGFlag LogLevelFlags -- struct MainContext newtype MainContext = MainContext (ForeignPtr MainContext) noMainContext :: Maybe MainContext noMainContext = Nothing foreign import ccall "g_main_context_get_type" c_g_main_context_get_type :: IO GType instance BoxedObject MainContext where boxedType _ = c_g_main_context_get_type -- method MainContext::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "MainContext" -- throws : False -- Skip return : False foreign import ccall "g_main_context_new" g_main_context_new :: IO (Ptr MainContext) mainContextNew :: (MonadIO m) => m MainContext mainContextNew = liftIO $ do result <- g_main_context_new result' <- (wrapBoxed MainContext) result return result' -- method MainContext::acquire -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_main_context_acquire" g_main_context_acquire :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO CInt mainContextAcquire :: (MonadIO m) => MainContext -> -- _obj m Bool mainContextAcquire _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_context_acquire _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MainContext::add_poll -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", 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_main_context_add_poll" g_main_context_add_poll :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Ptr PollFD -> -- fd : TInterface "GLib" "PollFD" Int32 -> -- priority : TBasicType TInt32 IO () mainContextAddPoll :: (MonadIO m) => MainContext -> -- _obj PollFD -> -- fd Int32 -> -- priority m () mainContextAddPoll _obj fd priority = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let fd' = unsafeManagedPtrGetPtr fd g_main_context_add_poll _obj' fd' priority touchManagedPtr _obj touchManagedPtr fd return () -- method MainContext::check -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fds", argType = TCArray False (-1) 3 (TInterface "GLib" "PollFD"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_fds", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "n_fds", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fds", argType = TCArray False (-1) 3 (TInterface "GLib" "PollFD"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_main_context_check" g_main_context_check :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Int32 -> -- max_priority : TBasicType TInt32 Ptr PollFD -> -- fds : TCArray False (-1) 3 (TInterface "GLib" "PollFD") Int32 -> -- n_fds : TBasicType TInt32 IO Int32 mainContextCheck :: (MonadIO m) => MainContext -> -- _obj Int32 -> -- max_priority [PollFD] -> -- fds m Int32 mainContextCheck _obj max_priority fds = liftIO $ do let n_fds = fromIntegral $ length fds let _obj' = unsafeManagedPtrGetPtr _obj let fds' = map unsafeManagedPtrGetPtr fds fds'' <- packBlockArray 8 fds' result <- g_main_context_check _obj' max_priority fds'' n_fds touchManagedPtr _obj mapM_ touchManagedPtr fds freeMem fds'' return result -- method MainContext::dispatch -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_context_dispatch" g_main_context_dispatch :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO () mainContextDispatch :: (MonadIO m) => MainContext -> -- _obj m () mainContextDispatch _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_context_dispatch _obj' touchManagedPtr _obj return () -- method MainContext::find_source_by_funcs_user_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "funcs", argType = TInterface "GLib" "SourceFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "funcs", argType = TInterface "GLib" "SourceFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_main_context_find_source_by_funcs_user_data" g_main_context_find_source_by_funcs_user_data :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Ptr SourceFuncs -> -- funcs : TInterface "GLib" "SourceFuncs" Ptr () -> -- user_data : TBasicType TVoid IO (Ptr Source) mainContextFindSourceByFuncsUserData :: (MonadIO m) => MainContext -> -- _obj SourceFuncs -> -- funcs Ptr () -> -- user_data m Source mainContextFindSourceByFuncsUserData _obj funcs user_data = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let funcs' = unsafeManagedPtrGetPtr funcs result <- g_main_context_find_source_by_funcs_user_data _obj' funcs' user_data result' <- (newBoxed Source) result touchManagedPtr _obj touchManagedPtr funcs return result' -- method MainContext::find_source_by_id -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_main_context_find_source_by_id" g_main_context_find_source_by_id :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Word32 -> -- source_id : TBasicType TUInt32 IO (Ptr Source) mainContextFindSourceById :: (MonadIO m) => MainContext -> -- _obj Word32 -> -- source_id m Source mainContextFindSourceById _obj source_id = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_context_find_source_by_id _obj' source_id result' <- (newBoxed Source) result touchManagedPtr _obj return result' -- method MainContext::find_source_by_user_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_main_context_find_source_by_user_data" g_main_context_find_source_by_user_data :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Ptr () -> -- user_data : TBasicType TVoid IO (Ptr Source) mainContextFindSourceByUserData :: (MonadIO m) => MainContext -> -- _obj Ptr () -> -- user_data m Source mainContextFindSourceByUserData _obj user_data = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_context_find_source_by_user_data _obj' user_data result' <- (newBoxed Source) result touchManagedPtr _obj return result' -- method MainContext::invoke_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_context_invoke_full" g_main_context_invoke_full :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Int32 -> -- priority : TBasicType TInt32 FunPtr SourceFuncC -> -- function : TInterface "GLib" "SourceFunc" Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO () mainContextInvokeFull :: (MonadIO m) => MainContext -> -- _obj Int32 -> -- priority SourceFunc -> -- function m () mainContextInvokeFull _obj priority function = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj function' <- mkSourceFunc (sourceFuncWrapper Nothing function) let data_ = castFunPtrToPtr function' let notify = safeFreeFunPtrPtr g_main_context_invoke_full _obj' priority function' data_ notify touchManagedPtr _obj return () -- method MainContext::is_owner -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_main_context_is_owner" g_main_context_is_owner :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO CInt mainContextIsOwner :: (MonadIO m) => MainContext -> -- _obj m Bool mainContextIsOwner _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_context_is_owner _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MainContext::iteration -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "may_block", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "may_block", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_main_context_iteration" g_main_context_iteration :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" CInt -> -- may_block : TBasicType TBoolean IO CInt mainContextIteration :: (MonadIO m) => MainContext -> -- _obj Bool -> -- may_block m Bool mainContextIteration _obj may_block = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let may_block' = (fromIntegral . fromEnum) may_block result <- g_main_context_iteration _obj' may_block' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MainContext::pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_main_context_pending" g_main_context_pending :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO CInt mainContextPending :: (MonadIO m) => MainContext -> -- _obj m Bool mainContextPending _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_context_pending _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MainContext::pop_thread_default -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_context_pop_thread_default" g_main_context_pop_thread_default :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO () mainContextPopThreadDefault :: (MonadIO m) => MainContext -> -- _obj m () mainContextPopThreadDefault _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_context_pop_thread_default _obj' touchManagedPtr _obj return () -- method MainContext::prepare -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_main_context_prepare" g_main_context_prepare :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Int32 -> -- priority : TBasicType TInt32 IO CInt mainContextPrepare :: (MonadIO m) => MainContext -> -- _obj Int32 -> -- priority m Bool mainContextPrepare _obj priority = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_context_prepare _obj' priority let result' = (/= 0) result touchManagedPtr _obj return result' -- method MainContext::push_thread_default -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_context_push_thread_default" g_main_context_push_thread_default :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO () mainContextPushThreadDefault :: (MonadIO m) => MainContext -> -- _obj m () mainContextPushThreadDefault _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_context_push_thread_default _obj' touchManagedPtr _obj return () -- method MainContext::query -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "fds", argType = TCArray False (-1) 4 (TInterface "GLib" "PollFD"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_fds", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_fds", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_main_context_query" g_main_context_query :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Int32 -> -- max_priority : TBasicType TInt32 Ptr Int32 -> -- timeout_ : TBasicType TInt32 Ptr (Ptr PollFD) -> -- fds : TCArray False (-1) 4 (TInterface "GLib" "PollFD") Ptr Int32 -> -- n_fds : TBasicType TInt32 IO Int32 mainContextQuery :: (MonadIO m) => MainContext -> -- _obj Int32 -> -- max_priority m (Int32,Int32,[PollFD]) mainContextQuery _obj max_priority = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj timeout_ <- allocMem :: IO (Ptr Int32) fds <- allocMem :: IO (Ptr (Ptr PollFD)) n_fds <- allocMem :: IO (Ptr Int32) result <- g_main_context_query _obj' max_priority timeout_ fds n_fds n_fds' <- peek n_fds timeout_' <- peek timeout_ fds' <- peek fds fds'' <- (unpackBoxedArrayWithLength 8 n_fds') fds' fds''' <- mapM (newBoxed PollFD) fds'' touchManagedPtr _obj freeMem timeout_ freeMem fds freeMem n_fds return (result, timeout_', fds''') -- method MainContext::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MainContext" -- throws : False -- Skip return : False foreign import ccall "g_main_context_ref" g_main_context_ref :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO (Ptr MainContext) mainContextRef :: (MonadIO m) => MainContext -> -- _obj m MainContext mainContextRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_context_ref _obj' result' <- (wrapBoxed MainContext) result touchManagedPtr _obj return result' -- method MainContext::release -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_context_release" g_main_context_release :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO () mainContextRelease :: (MonadIO m) => MainContext -> -- _obj m () mainContextRelease _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_context_release _obj' touchManagedPtr _obj return () -- method MainContext::remove_poll -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_context_remove_poll" g_main_context_remove_poll :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Ptr PollFD -> -- fd : TInterface "GLib" "PollFD" IO () mainContextRemovePoll :: (MonadIO m) => MainContext -> -- _obj PollFD -> -- fd m () mainContextRemovePoll _obj fd = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let fd' = unsafeManagedPtrGetPtr fd g_main_context_remove_poll _obj' fd' touchManagedPtr _obj touchManagedPtr fd return () -- method MainContext::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_context_unref" g_main_context_unref :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO () mainContextUnref :: (MonadIO m) => MainContext -> -- _obj m () mainContextUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_context_unref _obj' touchManagedPtr _obj return () -- method MainContext::wait -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cond", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mutex", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cond", argType = TInterface "GLib" "Cond", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mutex", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_main_context_wait" g_main_context_wait :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" Ptr Cond -> -- cond : TInterface "GLib" "Cond" Ptr Mutex -> -- mutex : TInterface "GLib" "Mutex" IO CInt mainContextWait :: (MonadIO m) => MainContext -> -- _obj Cond -> -- cond Mutex -> -- mutex m Bool mainContextWait _obj cond mutex = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let cond' = unsafeManagedPtrGetPtr cond let mutex' = unsafeManagedPtrGetPtr mutex result <- g_main_context_wait _obj' cond' mutex' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr cond touchManagedPtr mutex return result' -- method MainContext::wakeup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_context_wakeup" g_main_context_wakeup :: Ptr MainContext -> -- _obj : TInterface "GLib" "MainContext" IO () mainContextWakeup :: (MonadIO m) => MainContext -> -- _obj m () mainContextWakeup _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_context_wakeup _obj' touchManagedPtr _obj return () -- struct MainLoop newtype MainLoop = MainLoop (ForeignPtr MainLoop) noMainLoop :: Maybe MainLoop noMainLoop = Nothing foreign import ccall "g_main_loop_get_type" c_g_main_loop_get_type :: IO GType instance BoxedObject MainLoop where boxedType _ = c_g_main_loop_get_type -- method MainLoop::new -- method type : Constructor -- Args : [Arg {argName = "context", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_running", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "context", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_running", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MainLoop" -- throws : False -- Skip return : False foreign import ccall "g_main_loop_new" g_main_loop_new :: Ptr MainContext -> -- context : TInterface "GLib" "MainContext" CInt -> -- is_running : TBasicType TBoolean IO (Ptr MainLoop) mainLoopNew :: (MonadIO m) => Maybe (MainContext) -> -- context Bool -> -- is_running m MainLoop mainLoopNew context is_running = liftIO $ do maybeContext <- case context of Nothing -> return nullPtr Just jContext -> do let jContext' = unsafeManagedPtrGetPtr jContext return jContext' let is_running' = (fromIntegral . fromEnum) is_running result <- g_main_loop_new maybeContext is_running' result' <- (wrapBoxed MainLoop) result whenJust context touchManagedPtr return result' -- method MainLoop::get_context -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MainContext" -- throws : False -- Skip return : False foreign import ccall "g_main_loop_get_context" g_main_loop_get_context :: Ptr MainLoop -> -- _obj : TInterface "GLib" "MainLoop" IO (Ptr MainContext) mainLoopGetContext :: (MonadIO m) => MainLoop -> -- _obj m MainContext mainLoopGetContext _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_loop_get_context _obj' result' <- (newBoxed MainContext) result touchManagedPtr _obj return result' -- method MainLoop::is_running -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_main_loop_is_running" g_main_loop_is_running :: Ptr MainLoop -> -- _obj : TInterface "GLib" "MainLoop" IO CInt mainLoopIsRunning :: (MonadIO m) => MainLoop -> -- _obj m Bool mainLoopIsRunning _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_loop_is_running _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MainLoop::quit -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_loop_quit" g_main_loop_quit :: Ptr MainLoop -> -- _obj : TInterface "GLib" "MainLoop" IO () mainLoopQuit :: (MonadIO m) => MainLoop -> -- _obj m () mainLoopQuit _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_loop_quit _obj' touchManagedPtr _obj return () -- method MainLoop::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MainLoop" -- throws : False -- Skip return : False foreign import ccall "g_main_loop_ref" g_main_loop_ref :: Ptr MainLoop -> -- _obj : TInterface "GLib" "MainLoop" IO (Ptr MainLoop) mainLoopRef :: (MonadIO m) => MainLoop -> -- _obj m MainLoop mainLoopRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_main_loop_ref _obj' result' <- (wrapBoxed MainLoop) result touchManagedPtr _obj return result' -- method MainLoop::run -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_loop_run" g_main_loop_run :: Ptr MainLoop -> -- _obj : TInterface "GLib" "MainLoop" IO () mainLoopRun :: (MonadIO m) => MainLoop -> -- _obj m () mainLoopRun _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_loop_run _obj' touchManagedPtr _obj return () -- method MainLoop::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MainLoop", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_main_loop_unref" g_main_loop_unref :: Ptr MainLoop -> -- _obj : TInterface "GLib" "MainLoop" IO () mainLoopUnref :: (MonadIO m) => MainLoop -> -- _obj m () mainLoopUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_main_loop_unref _obj' touchManagedPtr _obj return () -- struct MappedFile newtype MappedFile = MappedFile (ForeignPtr MappedFile) noMappedFile :: Maybe MappedFile noMappedFile = Nothing foreign import ccall "g_mapped_file_get_type" c_g_mapped_file_get_type :: IO GType instance BoxedObject MappedFile where boxedType _ = c_g_mapped_file_get_type -- method MappedFile::new -- method type : Constructor -- Args : [Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "writable", argType = TBasicType TBoolean, 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 = "writable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MappedFile" -- throws : True -- Skip return : False foreign import ccall "g_mapped_file_new" g_mapped_file_new :: CString -> -- filename : TBasicType TUTF8 CInt -> -- writable : TBasicType TBoolean Ptr (Ptr GError) -> -- error IO (Ptr MappedFile) mappedFileNew :: (MonadIO m) => T.Text -> -- filename Bool -> -- writable m MappedFile mappedFileNew filename writable = liftIO $ do filename' <- textToCString filename let writable' = (fromIntegral . fromEnum) writable onException (do result <- propagateGError $ g_mapped_file_new filename' writable' result' <- (wrapBoxed MappedFile) result freeMem filename' return result' ) (do freeMem filename' ) -- method MappedFile::new_from_fd -- method type : Constructor -- Args : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "writable", argType = TBasicType TBoolean, 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},Arg {argName = "writable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MappedFile" -- throws : True -- Skip return : False foreign import ccall "g_mapped_file_new_from_fd" g_mapped_file_new_from_fd :: Int32 -> -- fd : TBasicType TInt32 CInt -> -- writable : TBasicType TBoolean Ptr (Ptr GError) -> -- error IO (Ptr MappedFile) mappedFileNewFromFd :: (MonadIO m) => Int32 -> -- fd Bool -> -- writable m MappedFile mappedFileNewFromFd fd writable = liftIO $ do let writable' = (fromIntegral . fromEnum) writable onException (do result <- propagateGError $ g_mapped_file_new_from_fd fd writable' result' <- (wrapBoxed MappedFile) result return result' ) (do return () ) -- method MappedFile::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mapped_file_free" g_mapped_file_free :: Ptr MappedFile -> -- _obj : TInterface "GLib" "MappedFile" IO () {-# DEPRECATED mappedFileFree ["(Since version 2.22)","Use g_mapped_file_unref() instead."]#-} mappedFileFree :: (MonadIO m) => MappedFile -> -- _obj m () mappedFileFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_mapped_file_free _obj' touchManagedPtr _obj return () -- method MappedFile::get_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : False -- Skip return : False foreign import ccall "g_mapped_file_get_bytes" g_mapped_file_get_bytes :: Ptr MappedFile -> -- _obj : TInterface "GLib" "MappedFile" IO (Ptr Bytes) mappedFileGetBytes :: (MonadIO m) => MappedFile -> -- _obj m Bytes mappedFileGetBytes _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_mapped_file_get_bytes _obj' result' <- (wrapBoxed Bytes) result touchManagedPtr _obj return result' -- method MappedFile::get_contents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_mapped_file_get_contents" g_mapped_file_get_contents :: Ptr MappedFile -> -- _obj : TInterface "GLib" "MappedFile" IO CString mappedFileGetContents :: (MonadIO m) => MappedFile -> -- _obj m T.Text mappedFileGetContents _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_mapped_file_get_contents _obj' result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method MappedFile::get_length -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_mapped_file_get_length" g_mapped_file_get_length :: Ptr MappedFile -> -- _obj : TInterface "GLib" "MappedFile" IO Word64 mappedFileGetLength :: (MonadIO m) => MappedFile -> -- _obj m Word64 mappedFileGetLength _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_mapped_file_get_length _obj' touchManagedPtr _obj return result -- method MappedFile::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MappedFile" -- throws : False -- Skip return : False foreign import ccall "g_mapped_file_ref" g_mapped_file_ref :: Ptr MappedFile -> -- _obj : TInterface "GLib" "MappedFile" IO (Ptr MappedFile) mappedFileRef :: (MonadIO m) => MappedFile -> -- _obj m MappedFile mappedFileRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_mapped_file_ref _obj' result' <- (wrapBoxed MappedFile) result touchManagedPtr _obj return result' -- method MappedFile::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MappedFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mapped_file_unref" g_mapped_file_unref :: Ptr MappedFile -> -- _obj : TInterface "GLib" "MappedFile" IO () mappedFileUnref :: (MonadIO m) => MappedFile -> -- _obj m () mappedFileUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_mapped_file_unref _obj' touchManagedPtr _obj return () -- Flags MarkupCollectType data MarkupCollectType = MarkupCollectTypeInvalid | MarkupCollectTypeString | MarkupCollectTypeStrdup | MarkupCollectTypeBoolean | MarkupCollectTypeTristate | MarkupCollectTypeOptional | AnotherMarkupCollectType Int deriving (Show, Eq) instance Enum MarkupCollectType where fromEnum MarkupCollectTypeInvalid = 0 fromEnum MarkupCollectTypeString = 1 fromEnum MarkupCollectTypeStrdup = 2 fromEnum MarkupCollectTypeBoolean = 3 fromEnum MarkupCollectTypeTristate = 4 fromEnum MarkupCollectTypeOptional = 65536 fromEnum (AnotherMarkupCollectType k) = k toEnum 0 = MarkupCollectTypeInvalid toEnum 1 = MarkupCollectTypeString toEnum 2 = MarkupCollectTypeStrdup toEnum 3 = MarkupCollectTypeBoolean toEnum 4 = MarkupCollectTypeTristate toEnum 65536 = MarkupCollectTypeOptional toEnum k = AnotherMarkupCollectType k instance IsGFlag MarkupCollectType -- Enum MarkupError data MarkupError = MarkupErrorBadUtf8 | MarkupErrorEmpty | MarkupErrorParse | MarkupErrorUnknownElement | MarkupErrorUnknownAttribute | MarkupErrorInvalidContent | MarkupErrorMissingAttribute | AnotherMarkupError Int deriving (Show, Eq) instance Enum MarkupError where fromEnum MarkupErrorBadUtf8 = 0 fromEnum MarkupErrorEmpty = 1 fromEnum MarkupErrorParse = 2 fromEnum MarkupErrorUnknownElement = 3 fromEnum MarkupErrorUnknownAttribute = 4 fromEnum MarkupErrorInvalidContent = 5 fromEnum MarkupErrorMissingAttribute = 6 fromEnum (AnotherMarkupError k) = k toEnum 0 = MarkupErrorBadUtf8 toEnum 1 = MarkupErrorEmpty toEnum 2 = MarkupErrorParse toEnum 3 = MarkupErrorUnknownElement toEnum 4 = MarkupErrorUnknownAttribute toEnum 5 = MarkupErrorInvalidContent toEnum 6 = MarkupErrorMissingAttribute toEnum k = AnotherMarkupError k instance GErrorClass MarkupError where gerrorClassDomain _ = "g-markup-error-quark" catchMarkupError :: IO a -> (MarkupError -> GErrorMessage -> IO a) -> IO a catchMarkupError = catchGErrorJustDomain handleMarkupError :: (MarkupError -> GErrorMessage -> IO a) -> IO a -> IO a handleMarkupError = handleGErrorJustDomain -- struct MarkupParseContext newtype MarkupParseContext = MarkupParseContext (ForeignPtr MarkupParseContext) noMarkupParseContext :: Maybe MarkupParseContext noMarkupParseContext = Nothing foreign import ccall "g_markup_parse_context_get_type" c_g_markup_parse_context_get_type :: IO GType instance BoxedObject MarkupParseContext where boxedType _ = c_g_markup_parse_context_get_type -- method MarkupParseContext::new -- method type : Constructor -- Args : [Arg {argName = "parser", argType = TInterface "GLib" "MarkupParser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "MarkupParseFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data_dnotify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "parser", argType = TInterface "GLib" "MarkupParser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "MarkupParseFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data_dnotify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MarkupParseContext" -- throws : False -- Skip return : False foreign import ccall "g_markup_parse_context_new" g_markup_parse_context_new :: Ptr MarkupParser -> -- parser : TInterface "GLib" "MarkupParser" CUInt -> -- flags : TInterface "GLib" "MarkupParseFlags" Ptr () -> -- user_data : TBasicType TVoid FunPtr DestroyNotifyC -> -- user_data_dnotify : TInterface "GLib" "DestroyNotify" IO (Ptr MarkupParseContext) markupParseContextNew :: (MonadIO m) => MarkupParser -> -- parser [MarkupParseFlags] -> -- flags Ptr () -> -- user_data DestroyNotify -> -- user_data_dnotify m MarkupParseContext markupParseContextNew parser flags user_data user_data_dnotify = liftIO $ do let parser' = unsafeManagedPtrGetPtr parser let flags' = gflagsToWord flags ptruser_data_dnotify <- callocBytes $ sizeOf (undefined :: FunPtr DestroyNotifyC) user_data_dnotify' <- mkDestroyNotify (destroyNotifyWrapper (Just ptruser_data_dnotify) user_data_dnotify) poke ptruser_data_dnotify user_data_dnotify' result <- g_markup_parse_context_new parser' flags' user_data user_data_dnotify' result' <- (wrapBoxed MarkupParseContext) result touchManagedPtr parser return result' -- method MarkupParseContext::end_parse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_markup_parse_context_end_parse" g_markup_parse_context_end_parse :: Ptr MarkupParseContext -> -- _obj : TInterface "GLib" "MarkupParseContext" Ptr (Ptr GError) -> -- error IO CInt markupParseContextEndParse :: (MonadIO m) => MarkupParseContext -> -- _obj m () markupParseContextEndParse _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj onException (do _ <- propagateGError $ g_markup_parse_context_end_parse _obj' touchManagedPtr _obj return () ) (do return () ) -- method MarkupParseContext::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_markup_parse_context_free" g_markup_parse_context_free :: Ptr MarkupParseContext -> -- _obj : TInterface "GLib" "MarkupParseContext" IO () markupParseContextFree :: (MonadIO m) => MarkupParseContext -> -- _obj m () markupParseContextFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_markup_parse_context_free _obj' touchManagedPtr _obj return () -- method MarkupParseContext::get_element -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_markup_parse_context_get_element" g_markup_parse_context_get_element :: Ptr MarkupParseContext -> -- _obj : TInterface "GLib" "MarkupParseContext" IO CString markupParseContextGetElement :: (MonadIO m) => MarkupParseContext -> -- _obj m T.Text markupParseContextGetElement _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_markup_parse_context_get_element _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method MarkupParseContext::parse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_markup_parse_context_parse" g_markup_parse_context_parse :: Ptr MarkupParseContext -> -- _obj : TInterface "GLib" "MarkupParseContext" CString -> -- text : TBasicType TUTF8 Int64 -> -- text_len : TBasicType TInt64 Ptr (Ptr GError) -> -- error IO CInt markupParseContextParse :: (MonadIO m) => MarkupParseContext -> -- _obj T.Text -> -- text Int64 -> -- text_len m () markupParseContextParse _obj text text_len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text onException (do _ <- propagateGError $ g_markup_parse_context_parse _obj' text' text_len touchManagedPtr _obj freeMem text' return () ) (do freeMem text' ) -- method MarkupParseContext::push -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parser", argType = TInterface "GLib" "MarkupParser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parser", argType = TInterface "GLib" "MarkupParser", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_markup_parse_context_push" g_markup_parse_context_push :: Ptr MarkupParseContext -> -- _obj : TInterface "GLib" "MarkupParseContext" Ptr MarkupParser -> -- parser : TInterface "GLib" "MarkupParser" Ptr () -> -- user_data : TBasicType TVoid IO () markupParseContextPush :: (MonadIO m) => MarkupParseContext -> -- _obj MarkupParser -> -- parser Ptr () -> -- user_data m () markupParseContextPush _obj parser user_data = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let parser' = unsafeManagedPtrGetPtr parser g_markup_parse_context_push _obj' parser' user_data touchManagedPtr _obj touchManagedPtr parser return () -- method MarkupParseContext::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MarkupParseContext" -- throws : False -- Skip return : False foreign import ccall "g_markup_parse_context_ref" g_markup_parse_context_ref :: Ptr MarkupParseContext -> -- _obj : TInterface "GLib" "MarkupParseContext" IO (Ptr MarkupParseContext) markupParseContextRef :: (MonadIO m) => MarkupParseContext -> -- _obj m MarkupParseContext markupParseContextRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_markup_parse_context_ref _obj' result' <- (wrapBoxed MarkupParseContext) result touchManagedPtr _obj return result' -- method MarkupParseContext::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_markup_parse_context_unref" g_markup_parse_context_unref :: Ptr MarkupParseContext -> -- _obj : TInterface "GLib" "MarkupParseContext" IO () markupParseContextUnref :: (MonadIO m) => MarkupParseContext -> -- _obj m () markupParseContextUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_markup_parse_context_unref _obj' touchManagedPtr _obj return () -- Flags MarkupParseFlags data MarkupParseFlags = MarkupParseFlagsDoNotUseThisUnsupportedFlag | MarkupParseFlagsTreatCdataAsText | MarkupParseFlagsPrefixErrorPosition | MarkupParseFlagsIgnoreQualified | AnotherMarkupParseFlags Int deriving (Show, Eq) instance Enum MarkupParseFlags where fromEnum MarkupParseFlagsDoNotUseThisUnsupportedFlag = 1 fromEnum MarkupParseFlagsTreatCdataAsText = 2 fromEnum MarkupParseFlagsPrefixErrorPosition = 4 fromEnum MarkupParseFlagsIgnoreQualified = 8 fromEnum (AnotherMarkupParseFlags k) = k toEnum 1 = MarkupParseFlagsDoNotUseThisUnsupportedFlag toEnum 2 = MarkupParseFlagsTreatCdataAsText toEnum 4 = MarkupParseFlagsPrefixErrorPosition toEnum 8 = MarkupParseFlagsIgnoreQualified toEnum k = AnotherMarkupParseFlags k instance IsGFlag MarkupParseFlags -- struct MarkupParser newtype MarkupParser = MarkupParser (ForeignPtr MarkupParser) noMarkupParser :: Maybe MarkupParser noMarkupParser = Nothing -- XXX Skipped getter for "MarkupParser:start_element" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "MarkupParser:end_element" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "MarkupParser:text" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "MarkupParser:passthrough" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "MarkupParser:error" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- struct MatchInfo newtype MatchInfo = MatchInfo (ForeignPtr MatchInfo) noMatchInfo :: Maybe MatchInfo noMatchInfo = Nothing foreign import ccall "g_match_info_get_type" c_g_match_info_get_type :: IO GType instance BoxedObject MatchInfo where boxedType _ = c_g_match_info_get_type -- method MatchInfo::expand_references -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_to_expand", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_to_expand", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_match_info_expand_references" g_match_info_expand_references :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" CString -> -- string_to_expand : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString matchInfoExpandReferences :: (MonadIO m) => MatchInfo -> -- _obj T.Text -> -- string_to_expand m T.Text matchInfoExpandReferences _obj string_to_expand = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string_to_expand' <- textToCString string_to_expand onException (do result <- propagateGError $ g_match_info_expand_references _obj' string_to_expand' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem string_to_expand' return result' ) (do freeMem string_to_expand' ) -- method MatchInfo::fetch -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_num", 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_match_info_fetch" g_match_info_fetch :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" Int32 -> -- match_num : TBasicType TInt32 IO CString matchInfoFetch :: (MonadIO m) => MatchInfo -> -- _obj Int32 -> -- match_num m T.Text matchInfoFetch _obj match_num = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_match_info_fetch _obj' match_num result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method MatchInfo::fetch_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_match_info_fetch_all" g_match_info_fetch_all :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO (Ptr CString) matchInfoFetchAll :: (MonadIO m) => MatchInfo -> -- _obj m [T.Text] matchInfoFetchAll _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_match_info_fetch_all _obj' result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method MatchInfo::fetch_named -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_match_info_fetch_named" g_match_info_fetch_named :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" CString -> -- name : TBasicType TUTF8 IO CString matchInfoFetchNamed :: (MonadIO m) => MatchInfo -> -- _obj T.Text -> -- name m T.Text matchInfoFetchNamed _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_match_info_fetch_named _obj' name' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem name' return result' -- method MatchInfo::fetch_named_pos -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_pos", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end_pos", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_match_info_fetch_named_pos" g_match_info_fetch_named_pos :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" CString -> -- name : TBasicType TUTF8 Ptr Int32 -> -- start_pos : TBasicType TInt32 Ptr Int32 -> -- end_pos : TBasicType TInt32 IO CInt matchInfoFetchNamedPos :: (MonadIO m) => MatchInfo -> -- _obj T.Text -> -- name m (Bool,Int32,Int32) matchInfoFetchNamedPos _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name start_pos <- allocMem :: IO (Ptr Int32) end_pos <- allocMem :: IO (Ptr Int32) result <- g_match_info_fetch_named_pos _obj' name' start_pos end_pos let result' = (/= 0) result start_pos' <- peek start_pos end_pos' <- peek end_pos touchManagedPtr _obj freeMem name' freeMem start_pos freeMem end_pos return (result', start_pos', end_pos') -- method MatchInfo::fetch_pos -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_pos", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end_pos", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_match_info_fetch_pos" g_match_info_fetch_pos :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" Int32 -> -- match_num : TBasicType TInt32 Ptr Int32 -> -- start_pos : TBasicType TInt32 Ptr Int32 -> -- end_pos : TBasicType TInt32 IO CInt matchInfoFetchPos :: (MonadIO m) => MatchInfo -> -- _obj Int32 -> -- match_num m (Bool,Int32,Int32) matchInfoFetchPos _obj match_num = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj start_pos <- allocMem :: IO (Ptr Int32) end_pos <- allocMem :: IO (Ptr Int32) result <- g_match_info_fetch_pos _obj' match_num start_pos end_pos let result' = (/= 0) result start_pos' <- peek start_pos end_pos' <- peek end_pos touchManagedPtr _obj freeMem start_pos freeMem end_pos return (result', start_pos', end_pos') -- method MatchInfo::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_match_info_free" g_match_info_free :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO () matchInfoFree :: (MonadIO m) => MatchInfo -> -- _obj m () matchInfoFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_match_info_free _obj' touchManagedPtr _obj return () -- method MatchInfo::get_match_count -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_match_info_get_match_count" g_match_info_get_match_count :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO Int32 matchInfoGetMatchCount :: (MonadIO m) => MatchInfo -> -- _obj m Int32 matchInfoGetMatchCount _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_match_info_get_match_count _obj' touchManagedPtr _obj return result -- method MatchInfo::get_regex -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Regex" -- throws : False -- Skip return : False foreign import ccall "g_match_info_get_regex" g_match_info_get_regex :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO (Ptr Regex) matchInfoGetRegex :: (MonadIO m) => MatchInfo -> -- _obj m Regex matchInfoGetRegex _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_match_info_get_regex _obj' result' <- (wrapBoxed Regex) result touchManagedPtr _obj return result' -- method MatchInfo::get_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_match_info_get_string" g_match_info_get_string :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO CString matchInfoGetString :: (MonadIO m) => MatchInfo -> -- _obj m T.Text matchInfoGetString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_match_info_get_string _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method MatchInfo::is_partial_match -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_match_info_is_partial_match" g_match_info_is_partial_match :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO CInt matchInfoIsPartialMatch :: (MonadIO m) => MatchInfo -> -- _obj m Bool matchInfoIsPartialMatch _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_match_info_is_partial_match _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MatchInfo::matches -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_match_info_matches" g_match_info_matches :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO CInt matchInfoMatches :: (MonadIO m) => MatchInfo -> -- _obj m Bool matchInfoMatches _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_match_info_matches _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MatchInfo::next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_match_info_next" g_match_info_next :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" Ptr (Ptr GError) -> -- error IO CInt matchInfoNext :: (MonadIO m) => MatchInfo -> -- _obj m () matchInfoNext _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj onException (do _ <- propagateGError $ g_match_info_next _obj' touchManagedPtr _obj return () ) (do return () ) -- method MatchInfo::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MatchInfo" -- throws : False -- Skip return : False foreign import ccall "g_match_info_ref" g_match_info_ref :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO (Ptr MatchInfo) matchInfoRef :: (MonadIO m) => MatchInfo -> -- _obj m MatchInfo matchInfoRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_match_info_ref _obj' result' <- (wrapBoxed MatchInfo) result touchManagedPtr _obj return result' -- method MatchInfo::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "MatchInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_match_info_unref" g_match_info_unref :: Ptr MatchInfo -> -- _obj : TInterface "GLib" "MatchInfo" IO () matchInfoUnref :: (MonadIO m) => MatchInfo -> -- _obj m () matchInfoUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_match_info_unref _obj' touchManagedPtr _obj return () -- struct MemVTable newtype MemVTable = MemVTable (ForeignPtr MemVTable) noMemVTable :: Maybe MemVTable noMemVTable = Nothing -- XXX Skipped getter for "MemVTable:free" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- union Mutex newtype Mutex = Mutex (ForeignPtr Mutex) noMutex :: Maybe Mutex noMutex = Nothing -- method Mutex::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mutex_clear" g_mutex_clear :: Ptr Mutex -> -- _obj : TInterface "GLib" "Mutex" IO () mutexClear :: (MonadIO m) => Mutex -> -- _obj m () mutexClear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_mutex_clear _obj' touchManagedPtr _obj return () -- method Mutex::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mutex_init" g_mutex_init :: Ptr Mutex -> -- _obj : TInterface "GLib" "Mutex" IO () mutexInit :: (MonadIO m) => Mutex -> -- _obj m () mutexInit _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_mutex_init _obj' touchManagedPtr _obj return () -- method Mutex::lock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mutex_lock" g_mutex_lock :: Ptr Mutex -> -- _obj : TInterface "GLib" "Mutex" IO () mutexLock :: (MonadIO m) => Mutex -> -- _obj m () mutexLock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_mutex_lock _obj' touchManagedPtr _obj return () -- method Mutex::trylock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_mutex_trylock" g_mutex_trylock :: Ptr Mutex -> -- _obj : TInterface "GLib" "Mutex" IO CInt mutexTrylock :: (MonadIO m) => Mutex -> -- _obj m Bool mutexTrylock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_mutex_trylock _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Mutex::unlock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Mutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mutex_unlock" g_mutex_unlock :: Ptr Mutex -> -- _obj : TInterface "GLib" "Mutex" IO () mutexUnlock :: (MonadIO m) => Mutex -> -- _obj m () mutexUnlock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_mutex_unlock _obj' touchManagedPtr _obj return () -- struct Node newtype Node = Node (ForeignPtr Node) noNode :: Maybe Node noNode = Nothing nodeReadData :: Node -> IO (Ptr ()) nodeReadData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val nodeReadNext :: Node -> IO Node nodeReadNext s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr Node) val' <- (newPtr 40 Node) val return val' nodeReadPrev :: Node -> IO Node nodeReadPrev s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Node) val' <- (newPtr 40 Node) val return val' nodeReadParent :: Node -> IO Node nodeReadParent s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr Node) val' <- (newPtr 40 Node) val return val' nodeReadChildren :: Node -> IO Node nodeReadChildren s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO (Ptr Node) val' <- (newPtr 40 Node) val return val' -- method Node::child_index -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_node_child_index" g_node_child_index :: Ptr Node -> -- _obj : TInterface "GLib" "Node" Ptr () -> -- data : TBasicType TVoid IO Int32 nodeChildIndex :: (MonadIO m) => Node -> -- _obj Ptr () -> -- data m Int32 nodeChildIndex _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_node_child_index _obj' data_ touchManagedPtr _obj return result -- method Node::child_position -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_node_child_position" g_node_child_position :: Ptr Node -> -- _obj : TInterface "GLib" "Node" Ptr Node -> -- child : TInterface "GLib" "Node" IO Int32 nodeChildPosition :: (MonadIO m) => Node -> -- _obj Node -> -- child m Int32 nodeChildPosition _obj child = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let child' = unsafeManagedPtrGetPtr child result <- g_node_child_position _obj' child' touchManagedPtr _obj touchManagedPtr child return result -- method Node::depth -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_node_depth" g_node_depth :: Ptr Node -> -- _obj : TInterface "GLib" "Node" IO Word32 nodeDepth :: (MonadIO m) => Node -> -- _obj m Word32 nodeDepth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_node_depth _obj' touchManagedPtr _obj return result -- method Node::destroy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_node_destroy" g_node_destroy :: Ptr Node -> -- _obj : TInterface "GLib" "Node" IO () nodeDestroy :: (MonadIO m) => Node -> -- _obj m () nodeDestroy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_node_destroy _obj' touchManagedPtr _obj return () -- method Node::is_ancestor -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "descendant", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "descendant", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_node_is_ancestor" g_node_is_ancestor :: Ptr Node -> -- _obj : TInterface "GLib" "Node" Ptr Node -> -- descendant : TInterface "GLib" "Node" IO CInt nodeIsAncestor :: (MonadIO m) => Node -> -- _obj Node -> -- descendant m Bool nodeIsAncestor _obj descendant = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let descendant' = unsafeManagedPtrGetPtr descendant result <- g_node_is_ancestor _obj' descendant' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr descendant return result' -- method Node::max_height -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_node_max_height" g_node_max_height :: Ptr Node -> -- _obj : TInterface "GLib" "Node" IO Word32 nodeMaxHeight :: (MonadIO m) => Node -> -- _obj m Word32 nodeMaxHeight _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_node_max_height _obj' touchManagedPtr _obj return result -- method Node::n_children -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_node_n_children" g_node_n_children :: Ptr Node -> -- _obj : TInterface "GLib" "Node" IO Word32 nodeNChildren :: (MonadIO m) => Node -> -- _obj m Word32 nodeNChildren _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_node_n_children _obj' touchManagedPtr _obj return result -- method Node::n_nodes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "TraverseFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "TraverseFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_node_n_nodes" g_node_n_nodes :: Ptr Node -> -- _obj : TInterface "GLib" "Node" CUInt -> -- flags : TInterface "GLib" "TraverseFlags" IO Word32 nodeNNodes :: (MonadIO m) => Node -> -- _obj [TraverseFlags] -> -- flags m Word32 nodeNNodes _obj flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let flags' = gflagsToWord flags result <- g_node_n_nodes _obj' flags' touchManagedPtr _obj return result -- method Node::reverse_children -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_node_reverse_children" g_node_reverse_children :: Ptr Node -> -- _obj : TInterface "GLib" "Node" IO () nodeReverseChildren :: (MonadIO m) => Node -> -- _obj m () nodeReverseChildren _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_node_reverse_children _obj' touchManagedPtr _obj return () -- method Node::unlink -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Node", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_node_unlink" g_node_unlink :: Ptr Node -> -- _obj : TInterface "GLib" "Node" IO () nodeUnlink :: (MonadIO m) => Node -> -- _obj m () nodeUnlink _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_node_unlink _obj' touchManagedPtr _obj return () -- callback NodeForeachFunc nodeForeachFuncClosure :: NodeForeachFunc -> IO Closure nodeForeachFuncClosure cb = newCClosure =<< mkNodeForeachFunc wrapped where wrapped = nodeForeachFuncWrapper Nothing cb type NodeForeachFuncC = Ptr Node -> Ptr () -> IO () foreign import ccall "wrapper" mkNodeForeachFunc :: NodeForeachFuncC -> IO (FunPtr NodeForeachFuncC) type NodeForeachFunc = Node -> Ptr () -> IO () noNodeForeachFunc :: Maybe NodeForeachFunc noNodeForeachFunc = Nothing nodeForeachFuncWrapper :: Maybe (Ptr (FunPtr (NodeForeachFuncC))) -> NodeForeachFunc -> Ptr Node -> Ptr () -> IO () nodeForeachFuncWrapper funptrptr _cb node data_ = do node' <- (newPtr 40 Node) node _cb node' data_ maybeReleaseFunPtr funptrptr -- callback NodeTraverseFunc nodeTraverseFuncClosure :: NodeTraverseFunc -> IO Closure nodeTraverseFuncClosure cb = newCClosure =<< mkNodeTraverseFunc wrapped where wrapped = nodeTraverseFuncWrapper Nothing cb type NodeTraverseFuncC = Ptr Node -> Ptr () -> IO CInt foreign import ccall "wrapper" mkNodeTraverseFunc :: NodeTraverseFuncC -> IO (FunPtr NodeTraverseFuncC) type NodeTraverseFunc = Node -> Ptr () -> IO Bool noNodeTraverseFunc :: Maybe NodeTraverseFunc noNodeTraverseFunc = Nothing nodeTraverseFuncWrapper :: Maybe (Ptr (FunPtr (NodeTraverseFuncC))) -> NodeTraverseFunc -> Ptr Node -> Ptr () -> IO CInt nodeTraverseFuncWrapper funptrptr _cb node data_ = do node' <- (newPtr 40 Node) node result <- _cb node' data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Enum NormalizeMode data NormalizeMode = NormalizeModeDefault | NormalizeModeNfd | NormalizeModeDefaultCompose | NormalizeModeNfc | NormalizeModeAll | NormalizeModeNfkd | NormalizeModeAllCompose | NormalizeModeNfkc | AnotherNormalizeMode Int deriving (Show, Eq) instance Enum NormalizeMode where fromEnum NormalizeModeDefault = 0 fromEnum NormalizeModeNfd = 0 fromEnum NormalizeModeDefaultCompose = 1 fromEnum NormalizeModeNfc = 1 fromEnum NormalizeModeAll = 2 fromEnum NormalizeModeNfkd = 2 fromEnum NormalizeModeAllCompose = 3 fromEnum NormalizeModeNfkc = 3 fromEnum (AnotherNormalizeMode k) = k toEnum 0 = NormalizeModeDefault toEnum 1 = NormalizeModeDefaultCompose toEnum 2 = NormalizeModeAll toEnum 3 = NormalizeModeAllCompose toEnum k = AnotherNormalizeMode k -- struct Once newtype Once = Once (ForeignPtr Once) noOnce :: Maybe Once noOnce = Nothing onceReadStatus :: Once -> IO OnceStatus onceReadStatus s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' onceReadRetval :: Once -> IO (Ptr ()) onceReadRetval s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr ()) return val -- Enum OnceStatus data OnceStatus = OnceStatusNotcalled | OnceStatusProgress | OnceStatusReady | AnotherOnceStatus Int deriving (Show, Eq) instance Enum OnceStatus where fromEnum OnceStatusNotcalled = 0 fromEnum OnceStatusProgress = 1 fromEnum OnceStatusReady = 2 fromEnum (AnotherOnceStatus k) = k toEnum 0 = OnceStatusNotcalled toEnum 1 = OnceStatusProgress toEnum 2 = OnceStatusReady toEnum k = AnotherOnceStatus k -- Enum OptionArg data OptionArg = OptionArgNone | OptionArgString | OptionArgInt | OptionArgCallback | OptionArgFilename | OptionArgStringArray | OptionArgFilenameArray | OptionArgDouble | OptionArgInt64 | AnotherOptionArg Int deriving (Show, Eq) instance Enum OptionArg where fromEnum OptionArgNone = 0 fromEnum OptionArgString = 1 fromEnum OptionArgInt = 2 fromEnum OptionArgCallback = 3 fromEnum OptionArgFilename = 4 fromEnum OptionArgStringArray = 5 fromEnum OptionArgFilenameArray = 6 fromEnum OptionArgDouble = 7 fromEnum OptionArgInt64 = 8 fromEnum (AnotherOptionArg k) = k toEnum 0 = OptionArgNone toEnum 1 = OptionArgString toEnum 2 = OptionArgInt toEnum 3 = OptionArgCallback toEnum 4 = OptionArgFilename toEnum 5 = OptionArgStringArray toEnum 6 = OptionArgFilenameArray toEnum 7 = OptionArgDouble toEnum 8 = OptionArgInt64 toEnum k = AnotherOptionArg k -- callback OptionArgFunc optionArgFuncClosure :: OptionArgFunc -> IO Closure optionArgFuncClosure cb = newCClosure =<< mkOptionArgFunc wrapped where wrapped = optionArgFuncWrapper Nothing cb type OptionArgFuncC = CString -> CString -> Ptr () -> IO CInt foreign import ccall "wrapper" mkOptionArgFunc :: OptionArgFuncC -> IO (FunPtr OptionArgFuncC) type OptionArgFunc = T.Text -> T.Text -> Ptr () -> IO Bool noOptionArgFunc :: Maybe OptionArgFunc noOptionArgFunc = Nothing optionArgFuncWrapper :: Maybe (Ptr (FunPtr (OptionArgFuncC))) -> OptionArgFunc -> CString -> CString -> Ptr () -> IO CInt optionArgFuncWrapper funptrptr _cb option_name value data_ = do option_name' <- cstringToText option_name value' <- cstringToText value result <- _cb option_name' value' data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- struct OptionContext newtype OptionContext = OptionContext (ForeignPtr OptionContext) noOptionContext :: Maybe OptionContext noOptionContext = Nothing -- method OptionContext::add_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_context_add_group" g_option_context_add_group :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" Ptr OptionGroup -> -- group : TInterface "GLib" "OptionGroup" IO () optionContextAddGroup :: (MonadIO m) => OptionContext -> -- _obj OptionGroup -> -- group m () optionContextAddGroup _obj group = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group' <- copyBoxed group g_option_context_add_group _obj' group' touchManagedPtr _obj touchManagedPtr group return () -- method OptionContext::add_main_entries -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TInterface "GLib" "OptionEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "translation_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TInterface "GLib" "OptionEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "translation_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_context_add_main_entries" g_option_context_add_main_entries :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" Ptr OptionEntry -> -- entries : TInterface "GLib" "OptionEntry" CString -> -- translation_domain : TBasicType TUTF8 IO () optionContextAddMainEntries :: (MonadIO m) => OptionContext -> -- _obj OptionEntry -> -- entries Maybe (T.Text) -> -- translation_domain m () optionContextAddMainEntries _obj entries translation_domain = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let entries' = unsafeManagedPtrGetPtr entries maybeTranslation_domain <- case translation_domain of Nothing -> return nullPtr Just jTranslation_domain -> do jTranslation_domain' <- textToCString jTranslation_domain return jTranslation_domain' g_option_context_add_main_entries _obj' entries' maybeTranslation_domain touchManagedPtr _obj touchManagedPtr entries freeMem maybeTranslation_domain return () -- method OptionContext::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_context_free" g_option_context_free :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" IO () optionContextFree :: (MonadIO m) => OptionContext -> -- _obj m () optionContextFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_option_context_free _obj' touchManagedPtr _obj return () -- method OptionContext::get_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_option_context_get_description" g_option_context_get_description :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" IO CString optionContextGetDescription :: (MonadIO m) => OptionContext -> -- _obj m T.Text optionContextGetDescription _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_option_context_get_description _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method OptionContext::get_help -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "main_help", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "main_help", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_option_context_get_help" g_option_context_get_help :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" CInt -> -- main_help : TBasicType TBoolean Ptr OptionGroup -> -- group : TInterface "GLib" "OptionGroup" IO CString optionContextGetHelp :: (MonadIO m) => OptionContext -> -- _obj Bool -> -- main_help Maybe (OptionGroup) -> -- group m T.Text optionContextGetHelp _obj main_help group = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let main_help' = (fromIntegral . fromEnum) main_help maybeGroup <- case group of Nothing -> return nullPtr Just jGroup -> do let jGroup' = unsafeManagedPtrGetPtr jGroup return jGroup' result <- g_option_context_get_help _obj' main_help' maybeGroup result' <- cstringToText result freeMem result touchManagedPtr _obj whenJust group touchManagedPtr return result' -- method OptionContext::get_help_enabled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_option_context_get_help_enabled" g_option_context_get_help_enabled :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" IO CInt optionContextGetHelpEnabled :: (MonadIO m) => OptionContext -> -- _obj m Bool optionContextGetHelpEnabled _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_option_context_get_help_enabled _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method OptionContext::get_ignore_unknown_options -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_option_context_get_ignore_unknown_options" g_option_context_get_ignore_unknown_options :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" IO CInt optionContextGetIgnoreUnknownOptions :: (MonadIO m) => OptionContext -> -- _obj m Bool optionContextGetIgnoreUnknownOptions _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_option_context_get_ignore_unknown_options _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method OptionContext::get_main_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "OptionGroup" -- throws : False -- Skip return : False foreign import ccall "g_option_context_get_main_group" g_option_context_get_main_group :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" IO (Ptr OptionGroup) optionContextGetMainGroup :: (MonadIO m) => OptionContext -> -- _obj m OptionGroup optionContextGetMainGroup _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_option_context_get_main_group _obj' result' <- (newBoxed OptionGroup) result touchManagedPtr _obj return result' -- method OptionContext::get_strict_posix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_option_context_get_strict_posix" g_option_context_get_strict_posix :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" IO CInt optionContextGetStrictPosix :: (MonadIO m) => OptionContext -> -- _obj m Bool optionContextGetStrictPosix _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_option_context_get_strict_posix _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method OptionContext::get_summary -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_option_context_get_summary" g_option_context_get_summary :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" IO CString optionContextGetSummary :: (MonadIO m) => OptionContext -> -- _obj m T.Text optionContextGetSummary _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_option_context_get_summary _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- XXX Could not generate method OptionContext::parse -- Error was : Bad introspection data: "argument \"argc\" is not of nullable type, but it is marked as such." -- method OptionContext::parse_strv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arguments", argType = TCArray False (-1) (-1) (TBasicType TUTF8), direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arguments", argType = TCArray False (-1) (-1) (TBasicType TUTF8), direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_option_context_parse_strv" g_option_context_parse_strv :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" Ptr (Ptr CString) -> -- arguments : TCArray False (-1) (-1) (TBasicType TUTF8) Ptr (Ptr GError) -> -- error IO CInt optionContextParseStrv :: (MonadIO m) => OptionContext -> -- _obj Ptr CString -> -- arguments m ((Ptr CString)) optionContextParseStrv _obj arguments = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj arguments' <- allocMem :: IO (Ptr (Ptr CString)) poke arguments' arguments onException (do _ <- propagateGError $ g_option_context_parse_strv _obj' arguments' arguments'' <- peek arguments' touchManagedPtr _obj freeMem arguments' return arguments'' ) (do freeMem arguments' ) -- method OptionContext::set_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_context_set_description" g_option_context_set_description :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" CString -> -- description : TBasicType TUTF8 IO () optionContextSetDescription :: (MonadIO m) => OptionContext -> -- _obj Maybe (T.Text) -> -- description m () optionContextSetDescription _obj description = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeDescription <- case description of Nothing -> return nullPtr Just jDescription -> do jDescription' <- textToCString jDescription return jDescription' g_option_context_set_description _obj' maybeDescription touchManagedPtr _obj freeMem maybeDescription return () -- method OptionContext::set_help_enabled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "help_enabled", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "help_enabled", 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_option_context_set_help_enabled" g_option_context_set_help_enabled :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" CInt -> -- help_enabled : TBasicType TBoolean IO () optionContextSetHelpEnabled :: (MonadIO m) => OptionContext -> -- _obj Bool -> -- help_enabled m () optionContextSetHelpEnabled _obj help_enabled = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let help_enabled' = (fromIntegral . fromEnum) help_enabled g_option_context_set_help_enabled _obj' help_enabled' touchManagedPtr _obj return () -- method OptionContext::set_ignore_unknown_options -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ignore_unknown", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ignore_unknown", 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_option_context_set_ignore_unknown_options" g_option_context_set_ignore_unknown_options :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" CInt -> -- ignore_unknown : TBasicType TBoolean IO () optionContextSetIgnoreUnknownOptions :: (MonadIO m) => OptionContext -> -- _obj Bool -> -- ignore_unknown m () optionContextSetIgnoreUnknownOptions _obj ignore_unknown = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let ignore_unknown' = (fromIntegral . fromEnum) ignore_unknown g_option_context_set_ignore_unknown_options _obj' ignore_unknown' touchManagedPtr _obj return () -- method OptionContext::set_main_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_context_set_main_group" g_option_context_set_main_group :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" Ptr OptionGroup -> -- group : TInterface "GLib" "OptionGroup" IO () optionContextSetMainGroup :: (MonadIO m) => OptionContext -> -- _obj OptionGroup -> -- group m () optionContextSetMainGroup _obj group = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj group' <- copyBoxed group g_option_context_set_main_group _obj' group' touchManagedPtr _obj touchManagedPtr group return () -- method OptionContext::set_strict_posix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "strict_posix", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "strict_posix", 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_option_context_set_strict_posix" g_option_context_set_strict_posix :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" CInt -> -- strict_posix : TBasicType TBoolean IO () optionContextSetStrictPosix :: (MonadIO m) => OptionContext -> -- _obj Bool -> -- strict_posix m () optionContextSetStrictPosix _obj strict_posix = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let strict_posix' = (fromIntegral . fromEnum) strict_posix g_option_context_set_strict_posix _obj' strict_posix' touchManagedPtr _obj return () -- method OptionContext::set_summary -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "summary", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "summary", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_context_set_summary" g_option_context_set_summary :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" CString -> -- summary : TBasicType TUTF8 IO () optionContextSetSummary :: (MonadIO m) => OptionContext -> -- _obj Maybe (T.Text) -> -- summary m () optionContextSetSummary _obj summary = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeSummary <- case summary of Nothing -> return nullPtr Just jSummary -> do jSummary' <- textToCString jSummary return jSummary' g_option_context_set_summary _obj' maybeSummary touchManagedPtr _obj freeMem maybeSummary return () -- method OptionContext::set_translate_func -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "GLib" "TranslateFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "GLib" "TranslateFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_context_set_translate_func" g_option_context_set_translate_func :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" FunPtr TranslateFuncC -> -- func : TInterface "GLib" "TranslateFunc" Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- destroy_notify : TInterface "GLib" "DestroyNotify" IO () optionContextSetTranslateFunc :: (MonadIO m) => OptionContext -> -- _obj Maybe (TranslateFunc) -> -- func m () optionContextSetTranslateFunc _obj func = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeFunc <- case func of Nothing -> return (castPtrToFunPtr nullPtr) Just jFunc -> do jFunc' <- mkTranslateFunc (translateFuncWrapper Nothing jFunc) return jFunc' let data_ = castFunPtrToPtr maybeFunc let destroy_notify = safeFreeFunPtrPtr g_option_context_set_translate_func _obj' maybeFunc data_ destroy_notify touchManagedPtr _obj return () -- method OptionContext::set_translation_domain -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_context_set_translation_domain" g_option_context_set_translation_domain :: Ptr OptionContext -> -- _obj : TInterface "GLib" "OptionContext" CString -> -- domain : TBasicType TUTF8 IO () optionContextSetTranslationDomain :: (MonadIO m) => OptionContext -> -- _obj T.Text -> -- domain m () optionContextSetTranslationDomain _obj domain = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj domain' <- textToCString domain g_option_context_set_translation_domain _obj' domain' touchManagedPtr _obj freeMem domain' return () -- struct OptionEntry newtype OptionEntry = OptionEntry (ForeignPtr OptionEntry) noOptionEntry :: Maybe OptionEntry noOptionEntry = Nothing optionEntryReadLongName :: OptionEntry -> IO T.Text optionEntryReadLongName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' optionEntryReadShortName :: OptionEntry -> IO Int8 optionEntryReadShortName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int8 return val optionEntryReadFlags :: OptionEntry -> IO Int32 optionEntryReadFlags s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Int32 return val optionEntryReadArg :: OptionEntry -> IO OptionArg optionEntryReadArg s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' optionEntryReadArgData :: OptionEntry -> IO (Ptr ()) optionEntryReadArgData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr ()) return val optionEntryReadDescription :: OptionEntry -> IO T.Text optionEntryReadDescription s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO CString val' <- cstringToText val return val' optionEntryReadArgDescription :: OptionEntry -> IO T.Text optionEntryReadArgDescription s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO CString val' <- cstringToText val return val' -- Enum OptionError data OptionError = OptionErrorUnknownOption | OptionErrorBadValue | OptionErrorFailed | AnotherOptionError Int deriving (Show, Eq) instance Enum OptionError where fromEnum OptionErrorUnknownOption = 0 fromEnum OptionErrorBadValue = 1 fromEnum OptionErrorFailed = 2 fromEnum (AnotherOptionError k) = k toEnum 0 = OptionErrorUnknownOption toEnum 1 = OptionErrorBadValue toEnum 2 = OptionErrorFailed toEnum k = AnotherOptionError k instance GErrorClass OptionError where gerrorClassDomain _ = "g-option-context-error-quark" catchOptionError :: IO a -> (OptionError -> GErrorMessage -> IO a) -> IO a catchOptionError = catchGErrorJustDomain handleOptionError :: (OptionError -> GErrorMessage -> IO a) -> IO a -> IO a handleOptionError = handleGErrorJustDomain -- callback OptionErrorFunc optionErrorFuncClosure :: OptionErrorFunc -> IO Closure optionErrorFuncClosure cb = newCClosure =<< mkOptionErrorFunc wrapped where wrapped = optionErrorFuncWrapper Nothing cb type OptionErrorFuncC = Ptr OptionContext -> Ptr OptionGroup -> Ptr () -> IO () foreign import ccall "wrapper" mkOptionErrorFunc :: OptionErrorFuncC -> IO (FunPtr OptionErrorFuncC) type OptionErrorFunc = OptionContext -> OptionGroup -> Ptr () -> IO () noOptionErrorFunc :: Maybe OptionErrorFunc noOptionErrorFunc = Nothing optionErrorFuncWrapper :: Maybe (Ptr (FunPtr (OptionErrorFuncC))) -> OptionErrorFunc -> Ptr OptionContext -> Ptr OptionGroup -> Ptr () -> IO () optionErrorFuncWrapper funptrptr _cb context group data_ = do -- XXX Wrapping a foreign struct/union with no known destructor, leak? context' <- (\x -> OptionContext <$> newForeignPtr_ x) context group' <- (newBoxed OptionGroup) group _cb context' group' data_ maybeReleaseFunPtr funptrptr -- Flags OptionFlags data OptionFlags = OptionFlagsNone | OptionFlagsHidden | OptionFlagsInMain | OptionFlagsReverse | OptionFlagsNoArg | OptionFlagsFilename | OptionFlagsOptionalArg | OptionFlagsNoalias | AnotherOptionFlags Int deriving (Show, Eq) instance Enum OptionFlags where fromEnum OptionFlagsNone = 0 fromEnum OptionFlagsHidden = 1 fromEnum OptionFlagsInMain = 2 fromEnum OptionFlagsReverse = 4 fromEnum OptionFlagsNoArg = 8 fromEnum OptionFlagsFilename = 16 fromEnum OptionFlagsOptionalArg = 32 fromEnum OptionFlagsNoalias = 64 fromEnum (AnotherOptionFlags k) = k toEnum 0 = OptionFlagsNone toEnum 1 = OptionFlagsHidden toEnum 2 = OptionFlagsInMain toEnum 4 = OptionFlagsReverse toEnum 8 = OptionFlagsNoArg toEnum 16 = OptionFlagsFilename toEnum 32 = OptionFlagsOptionalArg toEnum 64 = OptionFlagsNoalias toEnum k = AnotherOptionFlags k instance IsGFlag OptionFlags -- struct OptionGroup newtype OptionGroup = OptionGroup (ForeignPtr OptionGroup) noOptionGroup :: Maybe OptionGroup noOptionGroup = Nothing foreign import ccall "g_option_group_get_type" c_g_option_group_get_type :: IO GType instance BoxedObject OptionGroup where boxedType _ = c_g_option_group_get_type -- method OptionGroup::new -- method type : Constructor -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "help_description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "help_description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "OptionGroup" -- throws : False -- Skip return : False foreign import ccall "g_option_group_new" g_option_group_new :: CString -> -- name : TBasicType TUTF8 CString -> -- description : TBasicType TUTF8 CString -> -- help_description : TBasicType TUTF8 Ptr () -> -- user_data : TBasicType TVoid FunPtr DestroyNotifyC -> -- destroy : TInterface "GLib" "DestroyNotify" IO (Ptr OptionGroup) optionGroupNew :: (MonadIO m) => T.Text -> -- name T.Text -> -- description T.Text -> -- help_description Maybe (Ptr ()) -> -- user_data Maybe (DestroyNotify) -> -- destroy m OptionGroup optionGroupNew name description help_description user_data destroy = liftIO $ do name' <- textToCString name description' <- textToCString description help_description' <- textToCString help_description maybeUser_data <- case user_data of Nothing -> return nullPtr Just jUser_data -> do return jUser_data ptrdestroy <- callocBytes $ sizeOf (undefined :: FunPtr DestroyNotifyC) maybeDestroy <- case destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jDestroy -> do jDestroy' <- mkDestroyNotify (destroyNotifyWrapper (Just ptrdestroy) jDestroy) poke ptrdestroy jDestroy' return jDestroy' result <- g_option_group_new name' description' help_description' maybeUser_data maybeDestroy result' <- (wrapBoxed OptionGroup) result freeMem name' freeMem description' freeMem help_description' return result' -- method OptionGroup::add_entries -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TInterface "GLib" "OptionEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TInterface "GLib" "OptionEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_group_add_entries" g_option_group_add_entries :: Ptr OptionGroup -> -- _obj : TInterface "GLib" "OptionGroup" Ptr OptionEntry -> -- entries : TInterface "GLib" "OptionEntry" IO () optionGroupAddEntries :: (MonadIO m) => OptionGroup -> -- _obj OptionEntry -> -- entries m () optionGroupAddEntries _obj entries = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let entries' = unsafeManagedPtrGetPtr entries g_option_group_add_entries _obj' entries' touchManagedPtr _obj touchManagedPtr entries return () -- method OptionGroup::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_group_free" g_option_group_free :: Ptr OptionGroup -> -- _obj : TInterface "GLib" "OptionGroup" IO () {-# DEPRECATED optionGroupFree ["(Since version 2.44)","Use g_option_group_unref() instead."]#-} optionGroupFree :: (MonadIO m) => OptionGroup -> -- _obj m () optionGroupFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_option_group_free _obj' touchManagedPtr _obj return () -- method OptionGroup::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "OptionGroup" -- throws : False -- Skip return : False foreign import ccall "g_option_group_ref" g_option_group_ref :: Ptr OptionGroup -> -- _obj : TInterface "GLib" "OptionGroup" IO (Ptr OptionGroup) optionGroupRef :: (MonadIO m) => OptionGroup -> -- _obj m OptionGroup optionGroupRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_option_group_ref _obj' result' <- (wrapBoxed OptionGroup) result touchManagedPtr _obj return result' -- method OptionGroup::set_translate_func -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "GLib" "TranslateFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "GLib" "TranslateFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_group_set_translate_func" g_option_group_set_translate_func :: Ptr OptionGroup -> -- _obj : TInterface "GLib" "OptionGroup" FunPtr TranslateFuncC -> -- func : TInterface "GLib" "TranslateFunc" Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- destroy_notify : TInterface "GLib" "DestroyNotify" IO () optionGroupSetTranslateFunc :: (MonadIO m) => OptionGroup -> -- _obj Maybe (TranslateFunc) -> -- func m () optionGroupSetTranslateFunc _obj func = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeFunc <- case func of Nothing -> return (castPtrToFunPtr nullPtr) Just jFunc -> do jFunc' <- mkTranslateFunc (translateFuncWrapper Nothing jFunc) return jFunc' let data_ = castFunPtrToPtr maybeFunc let destroy_notify = safeFreeFunPtrPtr g_option_group_set_translate_func _obj' maybeFunc data_ destroy_notify touchManagedPtr _obj return () -- method OptionGroup::set_translation_domain -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_group_set_translation_domain" g_option_group_set_translation_domain :: Ptr OptionGroup -> -- _obj : TInterface "GLib" "OptionGroup" CString -> -- domain : TBasicType TUTF8 IO () optionGroupSetTranslationDomain :: (MonadIO m) => OptionGroup -> -- _obj T.Text -> -- domain m () optionGroupSetTranslationDomain _obj domain = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj domain' <- textToCString domain g_option_group_set_translation_domain _obj' domain' touchManagedPtr _obj freeMem domain' return () -- method OptionGroup::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_option_group_unref" g_option_group_unref :: Ptr OptionGroup -> -- _obj : TInterface "GLib" "OptionGroup" IO () optionGroupUnref :: (MonadIO m) => OptionGroup -> -- _obj m () optionGroupUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_option_group_unref _obj' touchManagedPtr _obj return () -- callback OptionParseFunc optionParseFuncClosure :: OptionParseFunc -> IO Closure optionParseFuncClosure cb = newCClosure =<< mkOptionParseFunc wrapped where wrapped = optionParseFuncWrapper Nothing cb type OptionParseFuncC = Ptr OptionContext -> Ptr OptionGroup -> Ptr () -> IO CInt foreign import ccall "wrapper" mkOptionParseFunc :: OptionParseFuncC -> IO (FunPtr OptionParseFuncC) type OptionParseFunc = OptionContext -> OptionGroup -> Ptr () -> IO Bool noOptionParseFunc :: Maybe OptionParseFunc noOptionParseFunc = Nothing optionParseFuncWrapper :: Maybe (Ptr (FunPtr (OptionParseFuncC))) -> OptionParseFunc -> Ptr OptionContext -> Ptr OptionGroup -> Ptr () -> IO CInt optionParseFuncWrapper funptrptr _cb context group data_ = do -- XXX Wrapping a foreign struct/union with no known destructor, leak? context' <- (\x -> OptionContext <$> newForeignPtr_ x) context group' <- (newBoxed OptionGroup) group result <- _cb context' group' data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- struct PatternSpec newtype PatternSpec = PatternSpec (ForeignPtr PatternSpec) noPatternSpec :: Maybe PatternSpec noPatternSpec = Nothing -- method PatternSpec::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec2", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec2", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pattern_spec_equal" g_pattern_spec_equal :: Ptr PatternSpec -> -- _obj : TInterface "GLib" "PatternSpec" Ptr PatternSpec -> -- pspec2 : TInterface "GLib" "PatternSpec" IO CInt patternSpecEqual :: (MonadIO m) => PatternSpec -> -- _obj PatternSpec -> -- pspec2 m Bool patternSpecEqual _obj pspec2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let pspec2' = unsafeManagedPtrGetPtr pspec2 result <- g_pattern_spec_equal _obj' pspec2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr pspec2 return result' -- method PatternSpec::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_pattern_spec_free" g_pattern_spec_free :: Ptr PatternSpec -> -- _obj : TInterface "GLib" "PatternSpec" IO () patternSpecFree :: (MonadIO m) => PatternSpec -> -- _obj m () patternSpecFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_pattern_spec_free _obj' touchManagedPtr _obj return () -- struct PollFD newtype PollFD = PollFD (ForeignPtr PollFD) noPollFD :: Maybe PollFD noPollFD = Nothing foreign import ccall "g_pollfd_get_type" c_g_pollfd_get_type :: IO GType instance BoxedObject PollFD where boxedType _ = c_g_pollfd_get_type pollFDReadFd :: PollFD -> IO Int32 pollFDReadFd s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val pollFDReadEvents :: PollFD -> IO Word16 pollFDReadEvents s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word16 return val pollFDReadRevents :: PollFD -> IO Word16 pollFDReadRevents s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 6) :: IO Word16 return val -- callback PollFunc pollFuncClosure :: PollFunc -> IO Closure pollFuncClosure cb = newCClosure =<< mkPollFunc wrapped where wrapped = pollFuncWrapper Nothing cb type PollFuncC = Ptr PollFD -> Word32 -> Int32 -> IO Int32 foreign import ccall "wrapper" mkPollFunc :: PollFuncC -> IO (FunPtr PollFuncC) type PollFunc = PollFD -> Word32 -> Int32 -> IO Int32 noPollFunc :: Maybe PollFunc noPollFunc = Nothing pollFuncWrapper :: Maybe (Ptr (FunPtr (PollFuncC))) -> PollFunc -> Ptr PollFD -> Word32 -> Int32 -> IO Int32 pollFuncWrapper funptrptr _cb ufds nfsd timeout_ = do ufds' <- (newBoxed PollFD) ufds result <- _cb ufds' nfsd timeout_ maybeReleaseFunPtr funptrptr return result -- callback PrintFunc printFuncClosure :: PrintFunc -> IO Closure printFuncClosure cb = newCClosure =<< mkPrintFunc wrapped where wrapped = printFuncWrapper Nothing cb type PrintFuncC = CString -> IO () foreign import ccall "wrapper" mkPrintFunc :: PrintFuncC -> IO (FunPtr PrintFuncC) type PrintFunc = T.Text -> IO () noPrintFunc :: Maybe PrintFunc noPrintFunc = Nothing printFuncWrapper :: Maybe (Ptr (FunPtr (PrintFuncC))) -> PrintFunc -> CString -> IO () printFuncWrapper funptrptr _cb string = do string' <- cstringToText string _cb string' maybeReleaseFunPtr funptrptr -- struct PtrArray newtype PtrArray = PtrArray (ForeignPtr PtrArray) noPtrArray :: Maybe PtrArray noPtrArray = Nothing foreign import ccall "g_ptr_array_get_type" c_g_ptr_array_get_type :: IO GType instance BoxedObject PtrArray where boxedType _ = c_g_ptr_array_get_type ptrArrayReadPdata :: PtrArray -> IO (Ptr ()) ptrArrayReadPdata s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val ptrArrayReadLen :: PtrArray -> IO Word32 ptrArrayReadLen s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val -- struct Queue newtype Queue = Queue (ForeignPtr Queue) noQueue :: Maybe Queue noQueue = Nothing queueReadHead :: Queue -> IO ([Ptr ()]) queueReadHead s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr (GList (Ptr ()))) val' <- unpackGList val return val' queueReadTail :: Queue -> IO ([Ptr ()]) queueReadTail s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr (GList (Ptr ()))) val' <- unpackGList val return val' queueReadLength :: Queue -> IO Word32 queueReadLength s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word32 return val -- method Queue::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_queue_clear" g_queue_clear :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" IO () queueClear :: (MonadIO m) => Queue -> -- _obj m () queueClear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_queue_clear _obj' touchManagedPtr _obj return () -- method Queue::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_queue_free" g_queue_free :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" IO () queueFree :: (MonadIO m) => Queue -> -- _obj m () queueFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_queue_free _obj' touchManagedPtr _obj return () -- method Queue::free_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "free_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "free_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_queue_free_full" g_queue_free_full :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" FunPtr DestroyNotifyC -> -- free_func : TInterface "GLib" "DestroyNotify" IO () queueFreeFull :: (MonadIO m) => Queue -> -- _obj DestroyNotify -> -- free_func m () queueFreeFull _obj free_func = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ptrfree_func <- callocBytes $ sizeOf (undefined :: FunPtr DestroyNotifyC) free_func' <- mkDestroyNotify (destroyNotifyWrapper (Just ptrfree_func) free_func) poke ptrfree_func free_func' g_queue_free_full _obj' free_func' touchManagedPtr _obj return () -- method Queue::get_length -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_queue_get_length" g_queue_get_length :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" IO Word32 queueGetLength :: (MonadIO m) => Queue -> -- _obj m Word32 queueGetLength _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_queue_get_length _obj' touchManagedPtr _obj return result -- method Queue::index -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_queue_index" g_queue_index :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" Ptr () -> -- data : TBasicType TVoid IO Int32 queueIndex :: (MonadIO m) => Queue -> -- _obj Ptr () -> -- data m Int32 queueIndex _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_queue_index _obj' data_ touchManagedPtr _obj return result -- method Queue::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_queue_init" g_queue_init :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" IO () queueInit :: (MonadIO m) => Queue -> -- _obj m () queueInit _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_queue_init _obj' touchManagedPtr _obj return () -- method Queue::is_empty -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_queue_is_empty" g_queue_is_empty :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" IO CInt queueIsEmpty :: (MonadIO m) => Queue -> -- _obj m Bool queueIsEmpty _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_queue_is_empty _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Queue::push_head -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_queue_push_head" g_queue_push_head :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" Ptr () -> -- data : TBasicType TVoid IO () queuePushHead :: (MonadIO m) => Queue -> -- _obj Ptr () -> -- data m () queuePushHead _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_queue_push_head _obj' data_ touchManagedPtr _obj return () -- method Queue::push_nth -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", 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_queue_push_nth" g_queue_push_nth :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" Ptr () -> -- data : TBasicType TVoid Int32 -> -- n : TBasicType TInt32 IO () queuePushNth :: (MonadIO m) => Queue -> -- _obj Ptr () -> -- data Int32 -> -- n m () queuePushNth _obj data_ n = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_queue_push_nth _obj' data_ n touchManagedPtr _obj return () -- method Queue::push_tail -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_queue_push_tail" g_queue_push_tail :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" Ptr () -> -- data : TBasicType TVoid IO () queuePushTail :: (MonadIO m) => Queue -> -- _obj Ptr () -> -- data m () queuePushTail _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_queue_push_tail _obj' data_ touchManagedPtr _obj return () -- method Queue::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_queue_remove" g_queue_remove :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" Ptr () -> -- data : TBasicType TVoid IO CInt queueRemove :: (MonadIO m) => Queue -> -- _obj Ptr () -> -- data m Bool queueRemove _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_queue_remove _obj' data_ let result' = (/= 0) result touchManagedPtr _obj return result' -- method Queue::remove_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_queue_remove_all" g_queue_remove_all :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" Ptr () -> -- data : TBasicType TVoid IO Word32 queueRemoveAll :: (MonadIO m) => Queue -> -- _obj Ptr () -> -- data m Word32 queueRemoveAll _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_queue_remove_all _obj' data_ touchManagedPtr _obj return result -- method Queue::reverse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Queue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_queue_reverse" g_queue_reverse :: Ptr Queue -> -- _obj : TInterface "GLib" "Queue" IO () queueReverse :: (MonadIO m) => Queue -> -- _obj m () queueReverse _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_queue_reverse _obj' touchManagedPtr _obj return () -- struct RWLock newtype RWLock = RWLock (ForeignPtr RWLock) noRWLock :: Maybe RWLock noRWLock = Nothing -- method RWLock::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rw_lock_clear" g_rw_lock_clear :: Ptr RWLock -> -- _obj : TInterface "GLib" "RWLock" IO () rWLockClear :: (MonadIO m) => RWLock -> -- _obj m () rWLockClear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rw_lock_clear _obj' touchManagedPtr _obj return () -- method RWLock::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rw_lock_init" g_rw_lock_init :: Ptr RWLock -> -- _obj : TInterface "GLib" "RWLock" IO () rWLockInit :: (MonadIO m) => RWLock -> -- _obj m () rWLockInit _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rw_lock_init _obj' touchManagedPtr _obj return () -- method RWLock::reader_lock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rw_lock_reader_lock" g_rw_lock_reader_lock :: Ptr RWLock -> -- _obj : TInterface "GLib" "RWLock" IO () rWLockReaderLock :: (MonadIO m) => RWLock -> -- _obj m () rWLockReaderLock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rw_lock_reader_lock _obj' touchManagedPtr _obj return () -- method RWLock::reader_trylock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_rw_lock_reader_trylock" g_rw_lock_reader_trylock :: Ptr RWLock -> -- _obj : TInterface "GLib" "RWLock" IO CInt rWLockReaderTrylock :: (MonadIO m) => RWLock -> -- _obj m Bool rWLockReaderTrylock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_rw_lock_reader_trylock _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method RWLock::reader_unlock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rw_lock_reader_unlock" g_rw_lock_reader_unlock :: Ptr RWLock -> -- _obj : TInterface "GLib" "RWLock" IO () rWLockReaderUnlock :: (MonadIO m) => RWLock -> -- _obj m () rWLockReaderUnlock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rw_lock_reader_unlock _obj' touchManagedPtr _obj return () -- method RWLock::writer_lock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rw_lock_writer_lock" g_rw_lock_writer_lock :: Ptr RWLock -> -- _obj : TInterface "GLib" "RWLock" IO () rWLockWriterLock :: (MonadIO m) => RWLock -> -- _obj m () rWLockWriterLock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rw_lock_writer_lock _obj' touchManagedPtr _obj return () -- method RWLock::writer_trylock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_rw_lock_writer_trylock" g_rw_lock_writer_trylock :: Ptr RWLock -> -- _obj : TInterface "GLib" "RWLock" IO CInt rWLockWriterTrylock :: (MonadIO m) => RWLock -> -- _obj m Bool rWLockWriterTrylock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_rw_lock_writer_trylock _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method RWLock::writer_unlock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RWLock", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rw_lock_writer_unlock" g_rw_lock_writer_unlock :: Ptr RWLock -> -- _obj : TInterface "GLib" "RWLock" IO () rWLockWriterUnlock :: (MonadIO m) => RWLock -> -- _obj m () rWLockWriterUnlock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rw_lock_writer_unlock _obj' touchManagedPtr _obj return () -- struct Rand newtype Rand = Rand (ForeignPtr Rand) noRand :: Maybe Rand noRand = Nothing -- method Rand::double -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_rand_double" g_rand_double :: Ptr Rand -> -- _obj : TInterface "GLib" "Rand" IO CDouble randDouble :: (MonadIO m) => Rand -> -- _obj m Double randDouble _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_rand_double _obj' let result' = realToFrac result touchManagedPtr _obj return result' -- method Rand::double_range -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "begin", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "begin", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_rand_double_range" g_rand_double_range :: Ptr Rand -> -- _obj : TInterface "GLib" "Rand" CDouble -> -- begin : TBasicType TDouble CDouble -> -- end : TBasicType TDouble IO CDouble randDoubleRange :: (MonadIO m) => Rand -> -- _obj Double -> -- begin Double -> -- end m Double randDoubleRange _obj begin end = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let begin' = realToFrac begin let end' = realToFrac end result <- g_rand_double_range _obj' begin' end' let result' = realToFrac result touchManagedPtr _obj return result' -- method Rand::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rand_free" g_rand_free :: Ptr Rand -> -- _obj : TInterface "GLib" "Rand" IO () randFree :: (MonadIO m) => Rand -> -- _obj m () randFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rand_free _obj' touchManagedPtr _obj return () -- method Rand::int -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_rand_int" g_rand_int :: Ptr Rand -> -- _obj : TInterface "GLib" "Rand" IO Word32 randInt :: (MonadIO m) => Rand -> -- _obj m Word32 randInt _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_rand_int _obj' touchManagedPtr _obj return result -- method Rand::int_range -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "begin", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "begin", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_rand_int_range" g_rand_int_range :: Ptr Rand -> -- _obj : TInterface "GLib" "Rand" Int32 -> -- begin : TBasicType TInt32 Int32 -> -- end : TBasicType TInt32 IO Int32 randIntRange :: (MonadIO m) => Rand -> -- _obj Int32 -> -- begin Int32 -> -- end m Int32 randIntRange _obj begin end = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_rand_int_range _obj' begin end touchManagedPtr _obj return result -- method Rand::set_seed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seed", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seed", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rand_set_seed" g_rand_set_seed :: Ptr Rand -> -- _obj : TInterface "GLib" "Rand" Word32 -> -- seed : TBasicType TUInt32 IO () randSetSeed :: (MonadIO m) => Rand -> -- _obj Word32 -> -- seed m () randSetSeed _obj seed = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rand_set_seed _obj' seed touchManagedPtr _obj return () -- method Rand::set_seed_array -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seed", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seed_length", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Rand", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seed", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "seed_length", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rand_set_seed_array" g_rand_set_seed_array :: Ptr Rand -> -- _obj : TInterface "GLib" "Rand" Word32 -> -- seed : TBasicType TUInt32 Word32 -> -- seed_length : TBasicType TUInt32 IO () randSetSeedArray :: (MonadIO m) => Rand -> -- _obj Word32 -> -- seed Word32 -> -- seed_length m () randSetSeedArray _obj seed seed_length = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rand_set_seed_array _obj' seed seed_length touchManagedPtr _obj return () -- struct RecMutex newtype RecMutex = RecMutex (ForeignPtr RecMutex) noRecMutex :: Maybe RecMutex noRecMutex = Nothing -- method RecMutex::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rec_mutex_clear" g_rec_mutex_clear :: Ptr RecMutex -> -- _obj : TInterface "GLib" "RecMutex" IO () recMutexClear :: (MonadIO m) => RecMutex -> -- _obj m () recMutexClear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rec_mutex_clear _obj' touchManagedPtr _obj return () -- method RecMutex::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rec_mutex_init" g_rec_mutex_init :: Ptr RecMutex -> -- _obj : TInterface "GLib" "RecMutex" IO () recMutexInit :: (MonadIO m) => RecMutex -> -- _obj m () recMutexInit _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rec_mutex_init _obj' touchManagedPtr _obj return () -- method RecMutex::lock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rec_mutex_lock" g_rec_mutex_lock :: Ptr RecMutex -> -- _obj : TInterface "GLib" "RecMutex" IO () recMutexLock :: (MonadIO m) => RecMutex -> -- _obj m () recMutexLock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rec_mutex_lock _obj' touchManagedPtr _obj return () -- method RecMutex::trylock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_rec_mutex_trylock" g_rec_mutex_trylock :: Ptr RecMutex -> -- _obj : TInterface "GLib" "RecMutex" IO CInt recMutexTrylock :: (MonadIO m) => RecMutex -> -- _obj m Bool recMutexTrylock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_rec_mutex_trylock _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method RecMutex::unlock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "RecMutex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_rec_mutex_unlock" g_rec_mutex_unlock :: Ptr RecMutex -> -- _obj : TInterface "GLib" "RecMutex" IO () recMutexUnlock :: (MonadIO m) => RecMutex -> -- _obj m () recMutexUnlock _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_rec_mutex_unlock _obj' touchManagedPtr _obj return () -- struct Regex newtype Regex = Regex (ForeignPtr Regex) noRegex :: Maybe Regex noRegex = Nothing foreign import ccall "g_regex_get_type" c_g_regex_get_type :: IO GType instance BoxedObject Regex where boxedType _ = c_g_regex_get_type -- method Regex::new -- method type : Constructor -- Args : [Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "compile_options", argType = TInterface "GLib" "RegexCompileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "compile_options", argType = TInterface "GLib" "RegexCompileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Regex" -- throws : True -- Skip return : False foreign import ccall "g_regex_new" g_regex_new :: CString -> -- pattern : TBasicType TUTF8 CUInt -> -- compile_options : TInterface "GLib" "RegexCompileFlags" CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" Ptr (Ptr GError) -> -- error IO (Ptr Regex) regexNew :: (MonadIO m) => T.Text -> -- pattern [RegexCompileFlags] -> -- compile_options [RegexMatchFlags] -> -- match_options m Regex regexNew pattern compile_options match_options = liftIO $ do pattern' <- textToCString pattern let compile_options' = gflagsToWord compile_options let match_options' = gflagsToWord match_options onException (do result <- propagateGError $ g_regex_new pattern' compile_options' match_options' result' <- (wrapBoxed Regex) result freeMem pattern' return result' ) (do freeMem pattern' ) -- method Regex::get_capture_count -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_regex_get_capture_count" g_regex_get_capture_count :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO Int32 regexGetCaptureCount :: (MonadIO m) => Regex -> -- _obj m Int32 regexGetCaptureCount _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_regex_get_capture_count _obj' touchManagedPtr _obj return result -- method Regex::get_compile_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "RegexCompileFlags" -- throws : False -- Skip return : False foreign import ccall "g_regex_get_compile_flags" g_regex_get_compile_flags :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO CUInt regexGetCompileFlags :: (MonadIO m) => Regex -> -- _obj m [RegexCompileFlags] regexGetCompileFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_regex_get_compile_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method Regex::get_has_cr_or_lf -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_regex_get_has_cr_or_lf" g_regex_get_has_cr_or_lf :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO CInt regexGetHasCrOrLf :: (MonadIO m) => Regex -> -- _obj m Bool regexGetHasCrOrLf _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_regex_get_has_cr_or_lf _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Regex::get_match_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "RegexMatchFlags" -- throws : False -- Skip return : False foreign import ccall "g_regex_get_match_flags" g_regex_get_match_flags :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO CUInt regexGetMatchFlags :: (MonadIO m) => Regex -> -- _obj m [RegexMatchFlags] regexGetMatchFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_regex_get_match_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method Regex::get_max_backref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_regex_get_max_backref" g_regex_get_max_backref :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO Int32 regexGetMaxBackref :: (MonadIO m) => Regex -> -- _obj m Int32 regexGetMaxBackref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_regex_get_max_backref _obj' touchManagedPtr _obj return result -- method Regex::get_max_lookbehind -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_regex_get_max_lookbehind" g_regex_get_max_lookbehind :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO Int32 regexGetMaxLookbehind :: (MonadIO m) => Regex -> -- _obj m Int32 regexGetMaxLookbehind _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_regex_get_max_lookbehind _obj' touchManagedPtr _obj return result -- method Regex::get_pattern -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_regex_get_pattern" g_regex_get_pattern :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO CString regexGetPattern :: (MonadIO m) => Regex -> -- _obj m T.Text regexGetPattern _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_regex_get_pattern _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method Regex::get_string_number -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_regex_get_string_number" g_regex_get_string_number :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" CString -> -- name : TBasicType TUTF8 IO Int32 regexGetStringNumber :: (MonadIO m) => Regex -> -- _obj T.Text -> -- name m Int32 regexGetStringNumber _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_regex_get_string_number _obj' name' touchManagedPtr _obj freeMem name' return result -- method Regex::match -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_info", argType = TInterface "GLib" "MatchInfo", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_regex_match" g_regex_match :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" CString -> -- string : TBasicType TUTF8 CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" Ptr (Ptr MatchInfo) -> -- match_info : TInterface "GLib" "MatchInfo" IO CInt regexMatch :: (MonadIO m) => Regex -> -- _obj T.Text -> -- string [RegexMatchFlags] -> -- match_options m (Bool,MatchInfo) regexMatch _obj string match_options = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string' <- textToCString string let match_options' = gflagsToWord match_options match_info <- allocMem :: IO (Ptr (Ptr MatchInfo)) result <- g_regex_match _obj' string' match_options' match_info let result' = (/= 0) result match_info' <- peek match_info match_info'' <- (wrapBoxed MatchInfo) match_info' touchManagedPtr _obj freeMem string' freeMem match_info return (result', match_info'') -- method Regex::match_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_info", argType = TInterface "GLib" "MatchInfo", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_regex_match_all" g_regex_match_all :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" CString -> -- string : TBasicType TUTF8 CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" Ptr (Ptr MatchInfo) -> -- match_info : TInterface "GLib" "MatchInfo" IO CInt regexMatchAll :: (MonadIO m) => Regex -> -- _obj T.Text -> -- string [RegexMatchFlags] -> -- match_options m (Bool,MatchInfo) regexMatchAll _obj string match_options = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string' <- textToCString string let match_options' = gflagsToWord match_options match_info <- allocMem :: IO (Ptr (Ptr MatchInfo)) result <- g_regex_match_all _obj' string' match_options' match_info let result' = (/= 0) result match_info' <- peek match_info match_info'' <- (wrapBoxed MatchInfo) match_info' touchManagedPtr _obj freeMem string' freeMem match_info return (result', match_info'') -- method Regex::match_all_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_info", argType = TInterface "GLib" "MatchInfo", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_regex_match_all_full" g_regex_match_all_full :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" Ptr CString -> -- string : TCArray False (-1) 2 (TBasicType TUTF8) Int64 -> -- string_len : TBasicType TInt64 Int32 -> -- start_position : TBasicType TInt32 CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" Ptr (Ptr MatchInfo) -> -- match_info : TInterface "GLib" "MatchInfo" Ptr (Ptr GError) -> -- error IO CInt regexMatchAllFull :: (MonadIO m) => Regex -> -- _obj [T.Text] -> -- string Int32 -> -- start_position [RegexMatchFlags] -> -- match_options m (MatchInfo) regexMatchAllFull _obj string start_position match_options = liftIO $ do let string_len = fromIntegral $ length string let _obj' = unsafeManagedPtrGetPtr _obj string' <- packUTF8CArray string let match_options' = gflagsToWord match_options match_info <- allocMem :: IO (Ptr (Ptr MatchInfo)) onException (do _ <- propagateGError $ g_regex_match_all_full _obj' string' string_len start_position match_options' match_info match_info' <- peek match_info match_info'' <- (wrapBoxed MatchInfo) match_info' touchManagedPtr _obj (mapCArrayWithLength string_len) freeMem string' freeMem string' freeMem match_info return match_info'' ) (do (mapCArrayWithLength string_len) freeMem string' freeMem string' freeMem match_info ) -- method Regex::match_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_info", argType = TInterface "GLib" "MatchInfo", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_regex_match_full" g_regex_match_full :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" Ptr CString -> -- string : TCArray False (-1) 2 (TBasicType TUTF8) Int64 -> -- string_len : TBasicType TInt64 Int32 -> -- start_position : TBasicType TInt32 CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" Ptr (Ptr MatchInfo) -> -- match_info : TInterface "GLib" "MatchInfo" Ptr (Ptr GError) -> -- error IO CInt regexMatchFull :: (MonadIO m) => Regex -> -- _obj [T.Text] -> -- string Int32 -> -- start_position [RegexMatchFlags] -> -- match_options m (MatchInfo) regexMatchFull _obj string start_position match_options = liftIO $ do let string_len = fromIntegral $ length string let _obj' = unsafeManagedPtrGetPtr _obj string' <- packUTF8CArray string let match_options' = gflagsToWord match_options match_info <- allocMem :: IO (Ptr (Ptr MatchInfo)) onException (do _ <- propagateGError $ g_regex_match_full _obj' string' string_len start_position match_options' match_info match_info' <- peek match_info match_info'' <- (wrapBoxed MatchInfo) match_info' touchManagedPtr _obj (mapCArrayWithLength string_len) freeMem string' freeMem string' freeMem match_info return match_info'' ) (do (mapCArrayWithLength string_len) freeMem string' freeMem string' freeMem match_info ) -- method Regex::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Regex" -- throws : False -- Skip return : False foreign import ccall "g_regex_ref" g_regex_ref :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO (Ptr Regex) regexRef :: (MonadIO m) => Regex -> -- _obj m Regex regexRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_regex_ref _obj' result' <- (wrapBoxed Regex) result touchManagedPtr _obj return result' -- method Regex::replace -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replacement", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replacement", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_regex_replace" g_regex_replace :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" Ptr CString -> -- string : TCArray False (-1) 2 (TBasicType TUTF8) Int64 -> -- string_len : TBasicType TInt64 Int32 -> -- start_position : TBasicType TInt32 CString -> -- replacement : TBasicType TUTF8 CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" Ptr (Ptr GError) -> -- error IO CString regexReplace :: (MonadIO m) => Regex -> -- _obj [T.Text] -> -- string Int32 -> -- start_position T.Text -> -- replacement [RegexMatchFlags] -> -- match_options m T.Text regexReplace _obj string start_position replacement match_options = liftIO $ do let string_len = fromIntegral $ length string let _obj' = unsafeManagedPtrGetPtr _obj string' <- packUTF8CArray string replacement' <- textToCString replacement let match_options' = gflagsToWord match_options onException (do result <- propagateGError $ g_regex_replace _obj' string' string_len start_position replacement' match_options' result' <- cstringToText result freeMem result touchManagedPtr _obj (mapCArrayWithLength string_len) freeMem string' freeMem string' freeMem replacement' return result' ) (do (mapCArrayWithLength string_len) freeMem string' freeMem string' freeMem replacement' ) -- method Regex::replace_literal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replacement", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replacement", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_regex_replace_literal" g_regex_replace_literal :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" Ptr CString -> -- string : TCArray False (-1) 2 (TBasicType TUTF8) Int64 -> -- string_len : TBasicType TInt64 Int32 -> -- start_position : TBasicType TInt32 CString -> -- replacement : TBasicType TUTF8 CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" Ptr (Ptr GError) -> -- error IO CString regexReplaceLiteral :: (MonadIO m) => Regex -> -- _obj [T.Text] -> -- string Int32 -> -- start_position T.Text -> -- replacement [RegexMatchFlags] -> -- match_options m T.Text regexReplaceLiteral _obj string start_position replacement match_options = liftIO $ do let string_len = fromIntegral $ length string let _obj' = unsafeManagedPtrGetPtr _obj string' <- packUTF8CArray string replacement' <- textToCString replacement let match_options' = gflagsToWord match_options onException (do result <- propagateGError $ g_regex_replace_literal _obj' string' string_len start_position replacement' match_options' result' <- cstringToText result freeMem result touchManagedPtr _obj (mapCArrayWithLength string_len) freeMem string' freeMem string' freeMem replacement' return result' ) (do (mapCArrayWithLength string_len) freeMem string' freeMem string' freeMem replacement' ) -- method Regex::split -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_regex_split" g_regex_split :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" CString -> -- string : TBasicType TUTF8 CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" IO (Ptr CString) regexSplit :: (MonadIO m) => Regex -> -- _obj T.Text -> -- string [RegexMatchFlags] -> -- match_options m [T.Text] regexSplit _obj string match_options = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string' <- textToCString string let match_options' = gflagsToWord match_options result <- g_regex_split _obj' string' match_options' result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj freeMem string' return result' -- method Regex::split_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_tokens", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "string_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_tokens", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : True -- Skip return : False foreign import ccall "g_regex_split_full" g_regex_split_full :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" Ptr CString -> -- string : TCArray False (-1) 2 (TBasicType TUTF8) Int64 -> -- string_len : TBasicType TInt64 Int32 -> -- start_position : TBasicType TInt32 CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" Int32 -> -- max_tokens : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO (Ptr CString) regexSplitFull :: (MonadIO m) => Regex -> -- _obj [T.Text] -> -- string Int32 -> -- start_position [RegexMatchFlags] -> -- match_options Int32 -> -- max_tokens m [T.Text] regexSplitFull _obj string start_position match_options max_tokens = liftIO $ do let string_len = fromIntegral $ length string let _obj' = unsafeManagedPtrGetPtr _obj string' <- packUTF8CArray string let match_options' = gflagsToWord match_options onException (do result <- propagateGError $ g_regex_split_full _obj' string' string_len start_position match_options' max_tokens result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj (mapCArrayWithLength string_len) freeMem string' freeMem string' return result' ) (do (mapCArrayWithLength string_len) freeMem string' freeMem string' ) -- method Regex::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_regex_unref" g_regex_unref :: Ptr Regex -> -- _obj : TInterface "GLib" "Regex" IO () regexUnref :: (MonadIO m) => Regex -> -- _obj m () regexUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_regex_unref _obj' touchManagedPtr _obj return () -- Flags RegexCompileFlags data RegexCompileFlags = RegexCompileFlagsCaseless | RegexCompileFlagsMultiline | RegexCompileFlagsDotall | RegexCompileFlagsExtended | RegexCompileFlagsAnchored | RegexCompileFlagsDollarEndonly | RegexCompileFlagsUngreedy | RegexCompileFlagsRaw | RegexCompileFlagsNoAutoCapture | RegexCompileFlagsOptimize | RegexCompileFlagsFirstline | RegexCompileFlagsDupnames | RegexCompileFlagsNewlineCr | RegexCompileFlagsNewlineLf | RegexCompileFlagsNewlineCrlf | RegexCompileFlagsNewlineAnycrlf | RegexCompileFlagsBsrAnycrlf | RegexCompileFlagsJavascriptCompat | AnotherRegexCompileFlags Int deriving (Show, Eq) instance Enum RegexCompileFlags where fromEnum RegexCompileFlagsCaseless = 1 fromEnum RegexCompileFlagsMultiline = 2 fromEnum RegexCompileFlagsDotall = 4 fromEnum RegexCompileFlagsExtended = 8 fromEnum RegexCompileFlagsAnchored = 16 fromEnum RegexCompileFlagsDollarEndonly = 32 fromEnum RegexCompileFlagsUngreedy = 512 fromEnum RegexCompileFlagsRaw = 2048 fromEnum RegexCompileFlagsNoAutoCapture = 4096 fromEnum RegexCompileFlagsOptimize = 8192 fromEnum RegexCompileFlagsFirstline = 262144 fromEnum RegexCompileFlagsDupnames = 524288 fromEnum RegexCompileFlagsNewlineCr = 1048576 fromEnum RegexCompileFlagsNewlineLf = 2097152 fromEnum RegexCompileFlagsNewlineCrlf = 3145728 fromEnum RegexCompileFlagsNewlineAnycrlf = 5242880 fromEnum RegexCompileFlagsBsrAnycrlf = 8388608 fromEnum RegexCompileFlagsJavascriptCompat = 33554432 fromEnum (AnotherRegexCompileFlags k) = k toEnum 1 = RegexCompileFlagsCaseless toEnum 2 = RegexCompileFlagsMultiline toEnum 4 = RegexCompileFlagsDotall toEnum 8 = RegexCompileFlagsExtended toEnum 16 = RegexCompileFlagsAnchored toEnum 32 = RegexCompileFlagsDollarEndonly toEnum 512 = RegexCompileFlagsUngreedy toEnum 2048 = RegexCompileFlagsRaw toEnum 4096 = RegexCompileFlagsNoAutoCapture toEnum 8192 = RegexCompileFlagsOptimize toEnum 262144 = RegexCompileFlagsFirstline toEnum 524288 = RegexCompileFlagsDupnames toEnum 1048576 = RegexCompileFlagsNewlineCr toEnum 2097152 = RegexCompileFlagsNewlineLf toEnum 3145728 = RegexCompileFlagsNewlineCrlf toEnum 5242880 = RegexCompileFlagsNewlineAnycrlf toEnum 8388608 = RegexCompileFlagsBsrAnycrlf toEnum 33554432 = RegexCompileFlagsJavascriptCompat toEnum k = AnotherRegexCompileFlags k instance IsGFlag RegexCompileFlags -- Enum RegexError data RegexError = RegexErrorCompile | RegexErrorOptimize | RegexErrorReplace | RegexErrorMatch | RegexErrorInternal | RegexErrorStrayBackslash | RegexErrorMissingControlChar | RegexErrorUnrecognizedEscape | RegexErrorQuantifiersOutOfOrder | RegexErrorQuantifierTooBig | RegexErrorUnterminatedCharacterClass | RegexErrorInvalidEscapeInCharacterClass | RegexErrorRangeOutOfOrder | RegexErrorNothingToRepeat | RegexErrorUnrecognizedCharacter | RegexErrorPosixNamedClassOutsideClass | RegexErrorUnmatchedParenthesis | RegexErrorInexistentSubpatternReference | RegexErrorUnterminatedComment | RegexErrorExpressionTooLarge | RegexErrorMemoryError | RegexErrorVariableLengthLookbehind | RegexErrorMalformedCondition | RegexErrorTooManyConditionalBranches | RegexErrorAssertionExpected | RegexErrorUnknownPosixClassName | RegexErrorPosixCollatingElementsNotSupported | RegexErrorHexCodeTooLarge | RegexErrorInvalidCondition | RegexErrorSingleByteMatchInLookbehind | RegexErrorInfiniteLoop | RegexErrorMissingSubpatternNameTerminator | RegexErrorDuplicateSubpatternName | RegexErrorMalformedProperty | RegexErrorUnknownProperty | RegexErrorSubpatternNameTooLong | RegexErrorTooManySubpatterns | RegexErrorInvalidOctalValue | RegexErrorTooManyBranchesInDefine | RegexErrorDefineRepetion | RegexErrorInconsistentNewlineOptions | RegexErrorMissingBackReference | RegexErrorInvalidRelativeReference | RegexErrorBacktrackingControlVerbArgumentForbidden | RegexErrorUnknownBacktrackingControlVerb | RegexErrorNumberTooBig | RegexErrorMissingSubpatternName | RegexErrorMissingDigit | RegexErrorInvalidDataCharacter | RegexErrorExtraSubpatternName | RegexErrorBacktrackingControlVerbArgumentRequired | RegexErrorInvalidControlChar | RegexErrorMissingName | RegexErrorNotSupportedInClass | RegexErrorTooManyForwardReferences | RegexErrorNameTooLong | RegexErrorCharacterValueTooLarge | AnotherRegexError Int deriving (Show, Eq) instance Enum RegexError where fromEnum RegexErrorCompile = 0 fromEnum RegexErrorOptimize = 1 fromEnum RegexErrorReplace = 2 fromEnum RegexErrorMatch = 3 fromEnum RegexErrorInternal = 4 fromEnum RegexErrorStrayBackslash = 101 fromEnum RegexErrorMissingControlChar = 102 fromEnum RegexErrorUnrecognizedEscape = 103 fromEnum RegexErrorQuantifiersOutOfOrder = 104 fromEnum RegexErrorQuantifierTooBig = 105 fromEnum RegexErrorUnterminatedCharacterClass = 106 fromEnum RegexErrorInvalidEscapeInCharacterClass = 107 fromEnum RegexErrorRangeOutOfOrder = 108 fromEnum RegexErrorNothingToRepeat = 109 fromEnum RegexErrorUnrecognizedCharacter = 112 fromEnum RegexErrorPosixNamedClassOutsideClass = 113 fromEnum RegexErrorUnmatchedParenthesis = 114 fromEnum RegexErrorInexistentSubpatternReference = 115 fromEnum RegexErrorUnterminatedComment = 118 fromEnum RegexErrorExpressionTooLarge = 120 fromEnum RegexErrorMemoryError = 121 fromEnum RegexErrorVariableLengthLookbehind = 125 fromEnum RegexErrorMalformedCondition = 126 fromEnum RegexErrorTooManyConditionalBranches = 127 fromEnum RegexErrorAssertionExpected = 128 fromEnum RegexErrorUnknownPosixClassName = 130 fromEnum RegexErrorPosixCollatingElementsNotSupported = 131 fromEnum RegexErrorHexCodeTooLarge = 134 fromEnum RegexErrorInvalidCondition = 135 fromEnum RegexErrorSingleByteMatchInLookbehind = 136 fromEnum RegexErrorInfiniteLoop = 140 fromEnum RegexErrorMissingSubpatternNameTerminator = 142 fromEnum RegexErrorDuplicateSubpatternName = 143 fromEnum RegexErrorMalformedProperty = 146 fromEnum RegexErrorUnknownProperty = 147 fromEnum RegexErrorSubpatternNameTooLong = 148 fromEnum RegexErrorTooManySubpatterns = 149 fromEnum RegexErrorInvalidOctalValue = 151 fromEnum RegexErrorTooManyBranchesInDefine = 154 fromEnum RegexErrorDefineRepetion = 155 fromEnum RegexErrorInconsistentNewlineOptions = 156 fromEnum RegexErrorMissingBackReference = 157 fromEnum RegexErrorInvalidRelativeReference = 158 fromEnum RegexErrorBacktrackingControlVerbArgumentForbidden = 159 fromEnum RegexErrorUnknownBacktrackingControlVerb = 160 fromEnum RegexErrorNumberTooBig = 161 fromEnum RegexErrorMissingSubpatternName = 162 fromEnum RegexErrorMissingDigit = 163 fromEnum RegexErrorInvalidDataCharacter = 164 fromEnum RegexErrorExtraSubpatternName = 165 fromEnum RegexErrorBacktrackingControlVerbArgumentRequired = 166 fromEnum RegexErrorInvalidControlChar = 168 fromEnum RegexErrorMissingName = 169 fromEnum RegexErrorNotSupportedInClass = 171 fromEnum RegexErrorTooManyForwardReferences = 172 fromEnum RegexErrorNameTooLong = 175 fromEnum RegexErrorCharacterValueTooLarge = 176 fromEnum (AnotherRegexError k) = k toEnum 0 = RegexErrorCompile toEnum 1 = RegexErrorOptimize toEnum 2 = RegexErrorReplace toEnum 3 = RegexErrorMatch toEnum 4 = RegexErrorInternal toEnum 101 = RegexErrorStrayBackslash toEnum 102 = RegexErrorMissingControlChar toEnum 103 = RegexErrorUnrecognizedEscape toEnum 104 = RegexErrorQuantifiersOutOfOrder toEnum 105 = RegexErrorQuantifierTooBig toEnum 106 = RegexErrorUnterminatedCharacterClass toEnum 107 = RegexErrorInvalidEscapeInCharacterClass toEnum 108 = RegexErrorRangeOutOfOrder toEnum 109 = RegexErrorNothingToRepeat toEnum 112 = RegexErrorUnrecognizedCharacter toEnum 113 = RegexErrorPosixNamedClassOutsideClass toEnum 114 = RegexErrorUnmatchedParenthesis toEnum 115 = RegexErrorInexistentSubpatternReference toEnum 118 = RegexErrorUnterminatedComment toEnum 120 = RegexErrorExpressionTooLarge toEnum 121 = RegexErrorMemoryError toEnum 125 = RegexErrorVariableLengthLookbehind toEnum 126 = RegexErrorMalformedCondition toEnum 127 = RegexErrorTooManyConditionalBranches toEnum 128 = RegexErrorAssertionExpected toEnum 130 = RegexErrorUnknownPosixClassName toEnum 131 = RegexErrorPosixCollatingElementsNotSupported toEnum 134 = RegexErrorHexCodeTooLarge toEnum 135 = RegexErrorInvalidCondition toEnum 136 = RegexErrorSingleByteMatchInLookbehind toEnum 140 = RegexErrorInfiniteLoop toEnum 142 = RegexErrorMissingSubpatternNameTerminator toEnum 143 = RegexErrorDuplicateSubpatternName toEnum 146 = RegexErrorMalformedProperty toEnum 147 = RegexErrorUnknownProperty toEnum 148 = RegexErrorSubpatternNameTooLong toEnum 149 = RegexErrorTooManySubpatterns toEnum 151 = RegexErrorInvalidOctalValue toEnum 154 = RegexErrorTooManyBranchesInDefine toEnum 155 = RegexErrorDefineRepetion toEnum 156 = RegexErrorInconsistentNewlineOptions toEnum 157 = RegexErrorMissingBackReference toEnum 158 = RegexErrorInvalidRelativeReference toEnum 159 = RegexErrorBacktrackingControlVerbArgumentForbidden toEnum 160 = RegexErrorUnknownBacktrackingControlVerb toEnum 161 = RegexErrorNumberTooBig toEnum 162 = RegexErrorMissingSubpatternName toEnum 163 = RegexErrorMissingDigit toEnum 164 = RegexErrorInvalidDataCharacter toEnum 165 = RegexErrorExtraSubpatternName toEnum 166 = RegexErrorBacktrackingControlVerbArgumentRequired toEnum 168 = RegexErrorInvalidControlChar toEnum 169 = RegexErrorMissingName toEnum 171 = RegexErrorNotSupportedInClass toEnum 172 = RegexErrorTooManyForwardReferences toEnum 175 = RegexErrorNameTooLong toEnum 176 = RegexErrorCharacterValueTooLarge toEnum k = AnotherRegexError k instance GErrorClass RegexError where gerrorClassDomain _ = "g-regex-error-quark" catchRegexError :: IO a -> (RegexError -> GErrorMessage -> IO a) -> IO a catchRegexError = catchGErrorJustDomain handleRegexError :: (RegexError -> GErrorMessage -> IO a) -> IO a -> IO a handleRegexError = handleGErrorJustDomain -- callback RegexEvalCallback regexEvalCallbackClosure :: RegexEvalCallback -> IO Closure regexEvalCallbackClosure cb = newCClosure =<< mkRegexEvalCallback wrapped where wrapped = regexEvalCallbackWrapper Nothing cb type RegexEvalCallbackC = Ptr MatchInfo -> Ptr String -> Ptr () -> IO CInt foreign import ccall "wrapper" mkRegexEvalCallback :: RegexEvalCallbackC -> IO (FunPtr RegexEvalCallbackC) type RegexEvalCallback = MatchInfo -> String -> IO Bool noRegexEvalCallback :: Maybe RegexEvalCallback noRegexEvalCallback = Nothing regexEvalCallbackWrapper :: Maybe (Ptr (FunPtr (RegexEvalCallbackC))) -> RegexEvalCallback -> Ptr MatchInfo -> Ptr String -> Ptr () -> IO CInt regexEvalCallbackWrapper funptrptr _cb match_info result_ _ = do match_info' <- (newBoxed MatchInfo) match_info result_' <- (newBoxed String) result_ result <- _cb match_info' result_' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Flags RegexMatchFlags data RegexMatchFlags = RegexMatchFlagsAnchored | RegexMatchFlagsNotbol | RegexMatchFlagsNoteol | RegexMatchFlagsNotempty | RegexMatchFlagsPartial | RegexMatchFlagsNewlineCr | RegexMatchFlagsNewlineLf | RegexMatchFlagsNewlineCrlf | RegexMatchFlagsNewlineAny | RegexMatchFlagsNewlineAnycrlf | RegexMatchFlagsBsrAnycrlf | RegexMatchFlagsBsrAny | RegexMatchFlagsPartialSoft | RegexMatchFlagsPartialHard | RegexMatchFlagsNotemptyAtstart | AnotherRegexMatchFlags Int deriving (Show, Eq) instance Enum RegexMatchFlags where fromEnum RegexMatchFlagsAnchored = 16 fromEnum RegexMatchFlagsNotbol = 128 fromEnum RegexMatchFlagsNoteol = 256 fromEnum RegexMatchFlagsNotempty = 1024 fromEnum RegexMatchFlagsPartial = 32768 fromEnum RegexMatchFlagsNewlineCr = 1048576 fromEnum RegexMatchFlagsNewlineLf = 2097152 fromEnum RegexMatchFlagsNewlineCrlf = 3145728 fromEnum RegexMatchFlagsNewlineAny = 4194304 fromEnum RegexMatchFlagsNewlineAnycrlf = 5242880 fromEnum RegexMatchFlagsBsrAnycrlf = 8388608 fromEnum RegexMatchFlagsBsrAny = 16777216 fromEnum RegexMatchFlagsPartialSoft = 32768 fromEnum RegexMatchFlagsPartialHard = 134217728 fromEnum RegexMatchFlagsNotemptyAtstart = 268435456 fromEnum (AnotherRegexMatchFlags k) = k toEnum 16 = RegexMatchFlagsAnchored toEnum 128 = RegexMatchFlagsNotbol toEnum 256 = RegexMatchFlagsNoteol toEnum 1024 = RegexMatchFlagsNotempty toEnum 32768 = RegexMatchFlagsPartial toEnum 1048576 = RegexMatchFlagsNewlineCr toEnum 2097152 = RegexMatchFlagsNewlineLf toEnum 3145728 = RegexMatchFlagsNewlineCrlf toEnum 4194304 = RegexMatchFlagsNewlineAny toEnum 5242880 = RegexMatchFlagsNewlineAnycrlf toEnum 8388608 = RegexMatchFlagsBsrAnycrlf toEnum 16777216 = RegexMatchFlagsBsrAny toEnum 134217728 = RegexMatchFlagsPartialHard toEnum 268435456 = RegexMatchFlagsNotemptyAtstart toEnum k = AnotherRegexMatchFlags k instance IsGFlag RegexMatchFlags -- struct Scanner newtype Scanner = Scanner (ForeignPtr Scanner) noScanner :: Maybe Scanner noScanner = Nothing scannerReadUserData :: Scanner -> IO (Ptr ()) scannerReadUserData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val scannerReadMaxParseErrors :: Scanner -> IO Word32 scannerReadMaxParseErrors s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val scannerReadParseErrors :: Scanner -> IO Word32 scannerReadParseErrors s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Word32 return val scannerReadInputName :: Scanner -> IO T.Text scannerReadInputName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' scannerReadQdata :: Scanner -> IO Data scannerReadQdata s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr Data) -- XXX Wrapping a foreign struct/union with no known destructor, leak? val' <- (\x -> Data <$> newForeignPtr_ x) val return val' scannerReadConfig :: Scanner -> IO ScannerConfig scannerReadConfig s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO (Ptr ScannerConfig) val' <- (newPtr 128 ScannerConfig) val return val' scannerReadToken :: Scanner -> IO TokenType scannerReadToken s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' scannerReadValue :: Scanner -> IO TokenValue scannerReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO (Ptr TokenValue) val' <- (newPtr 8 TokenValue) val return val' scannerReadLine :: Scanner -> IO Word32 scannerReadLine s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 56) :: IO Word32 return val scannerReadPosition :: Scanner -> IO Word32 scannerReadPosition s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 60) :: IO Word32 return val scannerReadNextToken :: Scanner -> IO TokenType scannerReadNextToken s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 64) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' scannerReadNextValue :: Scanner -> IO TokenValue scannerReadNextValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 72) :: IO (Ptr TokenValue) val' <- (newPtr 8 TokenValue) val return val' scannerReadNextLine :: Scanner -> IO Word32 scannerReadNextLine s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 80) :: IO Word32 return val scannerReadNextPosition :: Scanner -> IO Word32 scannerReadNextPosition s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 84) :: IO Word32 return val -- XXX Skipped getter for "Scanner:msg_handler" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- method Scanner::cur_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_scanner_cur_line" g_scanner_cur_line :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" IO Word32 scannerCurLine :: (MonadIO m) => Scanner -> -- _obj m Word32 scannerCurLine _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_scanner_cur_line _obj' touchManagedPtr _obj return result -- method Scanner::cur_position -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_scanner_cur_position" g_scanner_cur_position :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" IO Word32 scannerCurPosition :: (MonadIO m) => Scanner -> -- _obj m Word32 scannerCurPosition _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_scanner_cur_position _obj' touchManagedPtr _obj return result -- method Scanner::cur_token -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "TokenType" -- throws : False -- Skip return : False foreign import ccall "g_scanner_cur_token" g_scanner_cur_token :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" IO CUInt scannerCurToken :: (MonadIO m) => Scanner -> -- _obj m TokenType scannerCurToken _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_scanner_cur_token _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Scanner::destroy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_scanner_destroy" g_scanner_destroy :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" IO () scannerDestroy :: (MonadIO m) => Scanner -> -- _obj m () scannerDestroy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_scanner_destroy _obj' touchManagedPtr _obj return () -- method Scanner::eof -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_scanner_eof" g_scanner_eof :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" IO CInt scannerEof :: (MonadIO m) => Scanner -> -- _obj m Bool scannerEof _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_scanner_eof _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Scanner::get_next_token -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "TokenType" -- throws : False -- Skip return : False foreign import ccall "g_scanner_get_next_token" g_scanner_get_next_token :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" IO CUInt scannerGetNextToken :: (MonadIO m) => Scanner -> -- _obj m TokenType scannerGetNextToken _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_scanner_get_next_token _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Scanner::input_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "input_fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "input_fd", 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_scanner_input_file" g_scanner_input_file :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" Int32 -> -- input_fd : TBasicType TInt32 IO () scannerInputFile :: (MonadIO m) => Scanner -> -- _obj Int32 -> -- input_fd m () scannerInputFile _obj input_fd = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_scanner_input_file _obj' input_fd touchManagedPtr _obj return () -- method Scanner::input_text -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text_len", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text_len", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_scanner_input_text" g_scanner_input_text :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" CString -> -- text : TBasicType TUTF8 Word32 -> -- text_len : TBasicType TUInt32 IO () scannerInputText :: (MonadIO m) => Scanner -> -- _obj T.Text -> -- text Word32 -> -- text_len m () scannerInputText _obj text text_len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text g_scanner_input_text _obj' text' text_len touchManagedPtr _obj freeMem text' return () -- method Scanner::peek_next_token -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "TokenType" -- throws : False -- Skip return : False foreign import ccall "g_scanner_peek_next_token" g_scanner_peek_next_token :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" IO CUInt scannerPeekNextToken :: (MonadIO m) => Scanner -> -- _obj m TokenType scannerPeekNextToken _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_scanner_peek_next_token _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Scanner::scope_add_symbol -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scope_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symbol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scope_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symbol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_scanner_scope_add_symbol" g_scanner_scope_add_symbol :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" Word32 -> -- scope_id : TBasicType TUInt32 CString -> -- symbol : TBasicType TUTF8 Ptr () -> -- value : TBasicType TVoid IO () scannerScopeAddSymbol :: (MonadIO m) => Scanner -> -- _obj Word32 -> -- scope_id T.Text -> -- symbol Ptr () -> -- value m () scannerScopeAddSymbol _obj scope_id symbol value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj symbol' <- textToCString symbol g_scanner_scope_add_symbol _obj' scope_id symbol' value touchManagedPtr _obj freeMem symbol' return () -- method Scanner::scope_remove_symbol -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scope_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symbol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scope_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symbol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_scanner_scope_remove_symbol" g_scanner_scope_remove_symbol :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" Word32 -> -- scope_id : TBasicType TUInt32 CString -> -- symbol : TBasicType TUTF8 IO () scannerScopeRemoveSymbol :: (MonadIO m) => Scanner -> -- _obj Word32 -> -- scope_id T.Text -> -- symbol m () scannerScopeRemoveSymbol _obj scope_id symbol = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj symbol' <- textToCString symbol g_scanner_scope_remove_symbol _obj' scope_id symbol' touchManagedPtr _obj freeMem symbol' return () -- method Scanner::set_scope -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scope_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scope_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_scanner_set_scope" g_scanner_set_scope :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" Word32 -> -- scope_id : TBasicType TUInt32 IO Word32 scannerSetScope :: (MonadIO m) => Scanner -> -- _obj Word32 -> -- scope_id m Word32 scannerSetScope _obj scope_id = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_scanner_set_scope _obj' scope_id touchManagedPtr _obj return result -- method Scanner::sync_file_offset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_scanner_sync_file_offset" g_scanner_sync_file_offset :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" IO () scannerSyncFileOffset :: (MonadIO m) => Scanner -> -- _obj m () scannerSyncFileOffset _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_scanner_sync_file_offset _obj' touchManagedPtr _obj return () -- method Scanner::unexp_token -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expected_token", argType = TInterface "GLib" "TokenType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identifier_spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symbol_spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symbol_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_error", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Scanner", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expected_token", argType = TInterface "GLib" "TokenType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identifier_spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symbol_spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symbol_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_error", 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_scanner_unexp_token" g_scanner_unexp_token :: Ptr Scanner -> -- _obj : TInterface "GLib" "Scanner" CUInt -> -- expected_token : TInterface "GLib" "TokenType" CString -> -- identifier_spec : TBasicType TUTF8 CString -> -- symbol_spec : TBasicType TUTF8 CString -> -- symbol_name : TBasicType TUTF8 CString -> -- message : TBasicType TUTF8 Int32 -> -- is_error : TBasicType TInt32 IO () scannerUnexpToken :: (MonadIO m) => Scanner -> -- _obj TokenType -> -- expected_token T.Text -> -- identifier_spec T.Text -> -- symbol_spec T.Text -> -- symbol_name T.Text -> -- message Int32 -> -- is_error m () scannerUnexpToken _obj expected_token identifier_spec symbol_spec symbol_name message is_error = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let expected_token' = (fromIntegral . fromEnum) expected_token identifier_spec' <- textToCString identifier_spec symbol_spec' <- textToCString symbol_spec symbol_name' <- textToCString symbol_name message' <- textToCString message g_scanner_unexp_token _obj' expected_token' identifier_spec' symbol_spec' symbol_name' message' is_error touchManagedPtr _obj freeMem identifier_spec' freeMem symbol_spec' freeMem symbol_name' freeMem message' return () -- struct ScannerConfig newtype ScannerConfig = ScannerConfig (ForeignPtr ScannerConfig) noScannerConfig :: Maybe ScannerConfig noScannerConfig = Nothing scannerConfigReadCsetSkipCharacters :: ScannerConfig -> IO T.Text scannerConfigReadCsetSkipCharacters s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' scannerConfigReadCsetIdentifierFirst :: ScannerConfig -> IO T.Text scannerConfigReadCsetIdentifierFirst s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' scannerConfigReadCsetIdentifierNth :: ScannerConfig -> IO T.Text scannerConfigReadCsetIdentifierNth s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' scannerConfigReadCpairCommentSingle :: ScannerConfig -> IO T.Text scannerConfigReadCpairCommentSingle s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO CString val' <- cstringToText val return val' scannerConfigReadCaseSensitive :: ScannerConfig -> IO Word32 scannerConfigReadCaseSensitive s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO Word32 return val scannerConfigReadSkipCommentMulti :: ScannerConfig -> IO Word32 scannerConfigReadSkipCommentMulti s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 36) :: IO Word32 return val scannerConfigReadSkipCommentSingle :: ScannerConfig -> IO Word32 scannerConfigReadSkipCommentSingle s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO Word32 return val scannerConfigReadScanCommentMulti :: ScannerConfig -> IO Word32 scannerConfigReadScanCommentMulti s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 44) :: IO Word32 return val scannerConfigReadScanIdentifier :: ScannerConfig -> IO Word32 scannerConfigReadScanIdentifier s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO Word32 return val scannerConfigReadScanIdentifier1char :: ScannerConfig -> IO Word32 scannerConfigReadScanIdentifier1char s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 52) :: IO Word32 return val scannerConfigReadScanIdentifierNULL :: ScannerConfig -> IO Word32 scannerConfigReadScanIdentifierNULL s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 56) :: IO Word32 return val scannerConfigReadScanSymbols :: ScannerConfig -> IO Word32 scannerConfigReadScanSymbols s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 60) :: IO Word32 return val scannerConfigReadScanBinary :: ScannerConfig -> IO Word32 scannerConfigReadScanBinary s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 64) :: IO Word32 return val scannerConfigReadScanOctal :: ScannerConfig -> IO Word32 scannerConfigReadScanOctal s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 68) :: IO Word32 return val scannerConfigReadScanFloat :: ScannerConfig -> IO Word32 scannerConfigReadScanFloat s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 72) :: IO Word32 return val scannerConfigReadScanHex :: ScannerConfig -> IO Word32 scannerConfigReadScanHex s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 76) :: IO Word32 return val scannerConfigReadScanHexDollar :: ScannerConfig -> IO Word32 scannerConfigReadScanHexDollar s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 80) :: IO Word32 return val scannerConfigReadScanStringSq :: ScannerConfig -> IO Word32 scannerConfigReadScanStringSq s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 84) :: IO Word32 return val scannerConfigReadScanStringDq :: ScannerConfig -> IO Word32 scannerConfigReadScanStringDq s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 88) :: IO Word32 return val scannerConfigReadNumbers2Int :: ScannerConfig -> IO Word32 scannerConfigReadNumbers2Int s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 92) :: IO Word32 return val scannerConfigReadInt2Float :: ScannerConfig -> IO Word32 scannerConfigReadInt2Float s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 96) :: IO Word32 return val scannerConfigReadIdentifier2String :: ScannerConfig -> IO Word32 scannerConfigReadIdentifier2String s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 100) :: IO Word32 return val scannerConfigReadChar2Token :: ScannerConfig -> IO Word32 scannerConfigReadChar2Token s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 104) :: IO Word32 return val scannerConfigReadSymbol2Token :: ScannerConfig -> IO Word32 scannerConfigReadSymbol2Token s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 108) :: IO Word32 return val scannerConfigReadScope0Fallback :: ScannerConfig -> IO Word32 scannerConfigReadScope0Fallback s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 112) :: IO Word32 return val scannerConfigReadStoreInt64 :: ScannerConfig -> IO Word32 scannerConfigReadStoreInt64 s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 116) :: IO Word32 return val -- callback ScannerMsgFunc scannerMsgFuncClosure :: ScannerMsgFunc -> IO Closure scannerMsgFuncClosure cb = newCClosure =<< mkScannerMsgFunc wrapped where wrapped = scannerMsgFuncWrapper Nothing cb type ScannerMsgFuncC = Ptr Scanner -> CString -> CInt -> IO () foreign import ccall "wrapper" mkScannerMsgFunc :: ScannerMsgFuncC -> IO (FunPtr ScannerMsgFuncC) type ScannerMsgFunc = Scanner -> T.Text -> Bool -> IO () noScannerMsgFunc :: Maybe ScannerMsgFunc noScannerMsgFunc = Nothing scannerMsgFuncWrapper :: Maybe (Ptr (FunPtr (ScannerMsgFuncC))) -> ScannerMsgFunc -> Ptr Scanner -> CString -> CInt -> IO () scannerMsgFuncWrapper funptrptr _cb scanner message error_ = do scanner' <- (newPtr 144 Scanner) scanner message' <- cstringToText message let error_' = (/= 0) error_ _cb scanner' message' error_' maybeReleaseFunPtr funptrptr -- Enum SeekType data SeekType = SeekTypeCur | SeekTypeSet | SeekTypeEnd | AnotherSeekType Int deriving (Show, Eq) instance Enum SeekType where fromEnum SeekTypeCur = 0 fromEnum SeekTypeSet = 1 fromEnum SeekTypeEnd = 2 fromEnum (AnotherSeekType k) = k toEnum 0 = SeekTypeCur toEnum 1 = SeekTypeSet toEnum 2 = SeekTypeEnd toEnum k = AnotherSeekType k -- struct Sequence newtype Sequence = Sequence (ForeignPtr Sequence) noSequence :: Maybe Sequence noSequence = Nothing -- method Sequence::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Sequence", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Sequence", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_sequence_free" g_sequence_free :: Ptr Sequence -> -- _obj : TInterface "GLib" "Sequence" IO () sequenceFree :: (MonadIO m) => Sequence -> -- _obj m () sequenceFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_sequence_free _obj' touchManagedPtr _obj return () -- method Sequence::get_length -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Sequence", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Sequence", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_sequence_get_length" g_sequence_get_length :: Ptr Sequence -> -- _obj : TInterface "GLib" "Sequence" IO Int32 sequenceGetLength :: (MonadIO m) => Sequence -> -- _obj m Int32 sequenceGetLength _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_sequence_get_length _obj' touchManagedPtr _obj return result -- struct SequenceIter newtype SequenceIter = SequenceIter (ForeignPtr SequenceIter) noSequenceIter :: Maybe SequenceIter noSequenceIter = Nothing -- method SequenceIter::compare -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "b", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "b", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_sequence_iter_compare" g_sequence_iter_compare :: Ptr SequenceIter -> -- _obj : TInterface "GLib" "SequenceIter" Ptr SequenceIter -> -- b : TInterface "GLib" "SequenceIter" IO Int32 sequenceIterCompare :: (MonadIO m) => SequenceIter -> -- _obj SequenceIter -> -- b m Int32 sequenceIterCompare _obj b = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let b' = unsafeManagedPtrGetPtr b result <- g_sequence_iter_compare _obj' b' touchManagedPtr _obj touchManagedPtr b return result -- method SequenceIter::get_position -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_sequence_iter_get_position" g_sequence_iter_get_position :: Ptr SequenceIter -> -- _obj : TInterface "GLib" "SequenceIter" IO Int32 sequenceIterGetPosition :: (MonadIO m) => SequenceIter -> -- _obj m Int32 sequenceIterGetPosition _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_sequence_iter_get_position _obj' touchManagedPtr _obj return result -- method SequenceIter::is_begin -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_sequence_iter_is_begin" g_sequence_iter_is_begin :: Ptr SequenceIter -> -- _obj : TInterface "GLib" "SequenceIter" IO CInt sequenceIterIsBegin :: (MonadIO m) => SequenceIter -> -- _obj m Bool sequenceIterIsBegin _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_sequence_iter_is_begin _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method SequenceIter::is_end -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_sequence_iter_is_end" g_sequence_iter_is_end :: Ptr SequenceIter -> -- _obj : TInterface "GLib" "SequenceIter" IO CInt sequenceIterIsEnd :: (MonadIO m) => SequenceIter -> -- _obj m Bool sequenceIterIsEnd _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_sequence_iter_is_end _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- callback SequenceIterCompareFunc sequenceIterCompareFuncClosure :: SequenceIterCompareFunc -> IO Closure sequenceIterCompareFuncClosure cb = newCClosure =<< mkSequenceIterCompareFunc wrapped where wrapped = sequenceIterCompareFuncWrapper Nothing cb type SequenceIterCompareFuncC = Ptr SequenceIter -> Ptr SequenceIter -> Ptr () -> IO Int32 foreign import ccall "wrapper" mkSequenceIterCompareFunc :: SequenceIterCompareFuncC -> IO (FunPtr SequenceIterCompareFuncC) type SequenceIterCompareFunc = SequenceIter -> SequenceIter -> Ptr () -> IO Int32 noSequenceIterCompareFunc :: Maybe SequenceIterCompareFunc noSequenceIterCompareFunc = Nothing sequenceIterCompareFuncWrapper :: Maybe (Ptr (FunPtr (SequenceIterCompareFuncC))) -> SequenceIterCompareFunc -> Ptr SequenceIter -> Ptr SequenceIter -> Ptr () -> IO Int32 sequenceIterCompareFuncWrapper funptrptr _cb a b data_ = do -- XXX Wrapping a foreign struct/union with no known destructor, leak? a' <- (\x -> SequenceIter <$> newForeignPtr_ x) a -- XXX Wrapping a foreign struct/union with no known destructor, leak? b' <- (\x -> SequenceIter <$> newForeignPtr_ x) b result <- _cb a' b' data_ maybeReleaseFunPtr funptrptr return result -- Enum ShellError data ShellError = ShellErrorBadQuoting | ShellErrorEmptyString | ShellErrorFailed | AnotherShellError Int deriving (Show, Eq) instance Enum ShellError where fromEnum ShellErrorBadQuoting = 0 fromEnum ShellErrorEmptyString = 1 fromEnum ShellErrorFailed = 2 fromEnum (AnotherShellError k) = k toEnum 0 = ShellErrorBadQuoting toEnum 1 = ShellErrorEmptyString toEnum 2 = ShellErrorFailed toEnum k = AnotherShellError k instance GErrorClass ShellError where gerrorClassDomain _ = "g-shell-error-quark" catchShellError :: IO a -> (ShellError -> GErrorMessage -> IO a) -> IO a catchShellError = catchGErrorJustDomain handleShellError :: (ShellError -> GErrorMessage -> IO a) -> IO a -> IO a handleShellError = handleGErrorJustDomain -- Enum SliceConfig data SliceConfig = SliceConfigAlwaysMalloc | SliceConfigBypassMagazines | SliceConfigWorkingSetMsecs | SliceConfigColorIncrement | SliceConfigChunkSizes | SliceConfigContentionCounter | AnotherSliceConfig Int deriving (Show, Eq) instance Enum SliceConfig where fromEnum SliceConfigAlwaysMalloc = 1 fromEnum SliceConfigBypassMagazines = 2 fromEnum SliceConfigWorkingSetMsecs = 3 fromEnum SliceConfigColorIncrement = 4 fromEnum SliceConfigChunkSizes = 5 fromEnum SliceConfigContentionCounter = 6 fromEnum (AnotherSliceConfig k) = k toEnum 1 = SliceConfigAlwaysMalloc toEnum 2 = SliceConfigBypassMagazines toEnum 3 = SliceConfigWorkingSetMsecs toEnum 4 = SliceConfigColorIncrement toEnum 5 = SliceConfigChunkSizes toEnum 6 = SliceConfigContentionCounter toEnum k = AnotherSliceConfig k -- struct Source newtype Source = Source (ForeignPtr Source) noSource :: Maybe Source noSource = Nothing foreign import ccall "g_source_get_type" c_g_source_get_type :: IO GType instance BoxedObject Source where boxedType _ = c_g_source_get_type -- method Source::new -- method type : Constructor -- Args : [Arg {argName = "source_funcs", argType = TInterface "GLib" "SourceFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "struct_size", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "source_funcs", argType = TInterface "GLib" "SourceFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "struct_size", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_source_new" g_source_new :: Ptr SourceFuncs -> -- source_funcs : TInterface "GLib" "SourceFuncs" Word32 -> -- struct_size : TBasicType TUInt32 IO (Ptr Source) sourceNew :: (MonadIO m) => SourceFuncs -> -- source_funcs Word32 -> -- struct_size m Source sourceNew source_funcs struct_size = liftIO $ do let source_funcs' = unsafeManagedPtrGetPtr source_funcs result <- g_source_new source_funcs' struct_size result' <- (wrapBoxed Source) result touchManagedPtr source_funcs return result' -- method Source::add_child_source -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_add_child_source" g_source_add_child_source :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr Source -> -- child_source : TInterface "GLib" "Source" IO () sourceAddChildSource :: (MonadIO m) => Source -> -- _obj Source -> -- child_source m () sourceAddChildSource _obj child_source = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let child_source' = unsafeManagedPtrGetPtr child_source g_source_add_child_source _obj' child_source' touchManagedPtr _obj touchManagedPtr child_source return () -- method Source::add_poll -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_add_poll" g_source_add_poll :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr PollFD -> -- fd : TInterface "GLib" "PollFD" IO () sourceAddPoll :: (MonadIO m) => Source -> -- _obj PollFD -> -- fd m () sourceAddPoll _obj fd = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let fd' = unsafeManagedPtrGetPtr fd g_source_add_poll _obj' fd' touchManagedPtr _obj touchManagedPtr fd return () -- method Source::attach -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "context", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "context", argType = TInterface "GLib" "MainContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_source_attach" g_source_attach :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr MainContext -> -- context : TInterface "GLib" "MainContext" IO Word32 sourceAttach :: (MonadIO m) => Source -> -- _obj Maybe (MainContext) -> -- context m Word32 sourceAttach _obj context = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeContext <- case context of Nothing -> return nullPtr Just jContext -> do let jContext' = unsafeManagedPtrGetPtr jContext return jContext' result <- g_source_attach _obj' maybeContext touchManagedPtr _obj whenJust context touchManagedPtr return result -- method Source::destroy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_destroy" g_source_destroy :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO () sourceDestroy :: (MonadIO m) => Source -> -- _obj m () sourceDestroy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_source_destroy _obj' touchManagedPtr _obj return () -- method Source::get_can_recurse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_source_get_can_recurse" g_source_get_can_recurse :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO CInt sourceGetCanRecurse :: (MonadIO m) => Source -> -- _obj m Bool sourceGetCanRecurse _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_get_can_recurse _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Source::get_context -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MainContext" -- throws : False -- Skip return : False foreign import ccall "g_source_get_context" g_source_get_context :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO (Ptr MainContext) sourceGetContext :: (MonadIO m) => Source -> -- _obj m MainContext sourceGetContext _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_get_context _obj' result' <- (newBoxed MainContext) result touchManagedPtr _obj return result' -- method Source::get_current_time -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeval", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeval", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_get_current_time" g_source_get_current_time :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr TimeVal -> -- timeval : TInterface "GLib" "TimeVal" IO () {-# DEPRECATED sourceGetCurrentTime ["(Since version 2.28)","use g_source_get_time() instead"]#-} sourceGetCurrentTime :: (MonadIO m) => Source -> -- _obj TimeVal -> -- timeval m () sourceGetCurrentTime _obj timeval = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let timeval' = unsafeManagedPtrGetPtr timeval g_source_get_current_time _obj' timeval' touchManagedPtr _obj touchManagedPtr timeval return () -- method Source::get_id -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_source_get_id" g_source_get_id :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO Word32 sourceGetId :: (MonadIO m) => Source -> -- _obj m Word32 sourceGetId _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_get_id _obj' touchManagedPtr _obj return result -- method Source::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_source_get_name" g_source_get_name :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO CString sourceGetName :: (MonadIO m) => Source -> -- _obj m T.Text sourceGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_get_name _obj' result' <- cstringToText result touchManagedPtr _obj return result' -- method Source::get_priority -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_source_get_priority" g_source_get_priority :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO Int32 sourceGetPriority :: (MonadIO m) => Source -> -- _obj m Int32 sourceGetPriority _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_get_priority _obj' touchManagedPtr _obj return result -- method Source::get_ready_time -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_source_get_ready_time" g_source_get_ready_time :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO Int64 sourceGetReadyTime :: (MonadIO m) => Source -> -- _obj m Int64 sourceGetReadyTime _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_get_ready_time _obj' touchManagedPtr _obj return result -- method Source::get_time -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_source_get_time" g_source_get_time :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO Int64 sourceGetTime :: (MonadIO m) => Source -> -- _obj m Int64 sourceGetTime _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_get_time _obj' touchManagedPtr _obj return result -- method Source::is_destroyed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_source_is_destroyed" g_source_is_destroyed :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO CInt sourceIsDestroyed :: (MonadIO m) => Source -> -- _obj m Bool sourceIsDestroyed _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_is_destroyed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Source::modify_unix_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_events", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_events", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_modify_unix_fd" g_source_modify_unix_fd :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr () -> -- tag : TBasicType TVoid CUInt -> -- new_events : TInterface "GLib" "IOCondition" IO () sourceModifyUnixFd :: (MonadIO m) => Source -> -- _obj Ptr () -> -- tag [IOCondition] -> -- new_events m () sourceModifyUnixFd _obj tag new_events = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let new_events' = gflagsToWord new_events g_source_modify_unix_fd _obj' tag new_events' touchManagedPtr _obj return () -- method Source::query_unix_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TVoid, 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_source_query_unix_fd" g_source_query_unix_fd :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr () -> -- tag : TBasicType TVoid IO CUInt sourceQueryUnixFd :: (MonadIO m) => Source -> -- _obj Ptr () -> -- tag m [IOCondition] sourceQueryUnixFd _obj tag = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_query_unix_fd _obj' tag let result' = wordToGFlags result touchManagedPtr _obj return result' -- method Source::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_source_ref" g_source_ref :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO (Ptr Source) sourceRef :: (MonadIO m) => Source -> -- _obj m Source sourceRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_source_ref _obj' result' <- (wrapBoxed Source) result touchManagedPtr _obj return result' -- method Source::remove_child_source -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_remove_child_source" g_source_remove_child_source :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr Source -> -- child_source : TInterface "GLib" "Source" IO () sourceRemoveChildSource :: (MonadIO m) => Source -> -- _obj Source -> -- child_source m () sourceRemoveChildSource _obj child_source = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let child_source' = unsafeManagedPtrGetPtr child_source g_source_remove_child_source _obj' child_source' touchManagedPtr _obj touchManagedPtr child_source return () -- method Source::remove_poll -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_remove_poll" g_source_remove_poll :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr PollFD -> -- fd : TInterface "GLib" "PollFD" IO () sourceRemovePoll :: (MonadIO m) => Source -> -- _obj PollFD -> -- fd m () sourceRemovePoll _obj fd = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let fd' = unsafeManagedPtrGetPtr fd g_source_remove_poll _obj' fd' touchManagedPtr _obj touchManagedPtr fd return () -- method Source::remove_unix_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_remove_unix_fd" g_source_remove_unix_fd :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr () -> -- tag : TBasicType TVoid IO () sourceRemoveUnixFd :: (MonadIO m) => Source -> -- _obj Ptr () -> -- tag m () sourceRemoveUnixFd _obj tag = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_source_remove_unix_fd _obj' tag touchManagedPtr _obj return () -- method Source::set_callback -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_set_callback" g_source_set_callback :: Ptr Source -> -- _obj : TInterface "GLib" "Source" FunPtr SourceFuncC -> -- func : TInterface "GLib" "SourceFunc" Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO () sourceSetCallback :: (MonadIO m) => Source -> -- _obj SourceFunc -> -- func m () sourceSetCallback _obj func = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj func' <- mkSourceFunc (sourceFuncWrapper Nothing func) let data_ = castFunPtrToPtr func' let notify = safeFreeFunPtrPtr g_source_set_callback _obj' func' data_ notify touchManagedPtr _obj return () -- method Source::set_callback_indirect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback_funcs", argType = TInterface "GLib" "SourceCallbackFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback_funcs", argType = TInterface "GLib" "SourceCallbackFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_set_callback_indirect" g_source_set_callback_indirect :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr () -> -- callback_data : TBasicType TVoid Ptr SourceCallbackFuncs -> -- callback_funcs : TInterface "GLib" "SourceCallbackFuncs" IO () sourceSetCallbackIndirect :: (MonadIO m) => Source -> -- _obj Ptr () -> -- callback_data SourceCallbackFuncs -> -- callback_funcs m () sourceSetCallbackIndirect _obj callback_data callback_funcs = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let callback_funcs' = unsafeManagedPtrGetPtr callback_funcs g_source_set_callback_indirect _obj' callback_data callback_funcs' touchManagedPtr _obj touchManagedPtr callback_funcs return () -- method Source::set_can_recurse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "can_recurse", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "can_recurse", 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_source_set_can_recurse" g_source_set_can_recurse :: Ptr Source -> -- _obj : TInterface "GLib" "Source" CInt -> -- can_recurse : TBasicType TBoolean IO () sourceSetCanRecurse :: (MonadIO m) => Source -> -- _obj Bool -> -- can_recurse m () sourceSetCanRecurse _obj can_recurse = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let can_recurse' = (fromIntegral . fromEnum) can_recurse g_source_set_can_recurse _obj' can_recurse' touchManagedPtr _obj return () -- method Source::set_funcs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "funcs", argType = TInterface "GLib" "SourceFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "funcs", argType = TInterface "GLib" "SourceFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_set_funcs" g_source_set_funcs :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Ptr SourceFuncs -> -- funcs : TInterface "GLib" "SourceFuncs" IO () sourceSetFuncs :: (MonadIO m) => Source -> -- _obj SourceFuncs -> -- funcs m () sourceSetFuncs _obj funcs = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let funcs' = unsafeManagedPtrGetPtr funcs g_source_set_funcs _obj' funcs' touchManagedPtr _obj touchManagedPtr funcs return () -- method Source::set_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_set_name" g_source_set_name :: Ptr Source -> -- _obj : TInterface "GLib" "Source" CString -> -- name : TBasicType TUTF8 IO () sourceSetName :: (MonadIO m) => Source -> -- _obj T.Text -> -- name m () sourceSetName _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name g_source_set_name _obj' name' touchManagedPtr _obj freeMem name' return () -- method Source::set_priority -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", 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_source_set_priority" g_source_set_priority :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Int32 -> -- priority : TBasicType TInt32 IO () sourceSetPriority :: (MonadIO m) => Source -> -- _obj Int32 -> -- priority m () sourceSetPriority _obj priority = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_source_set_priority _obj' priority touchManagedPtr _obj return () -- method Source::set_ready_time -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ready_time", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ready_time", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_set_ready_time" g_source_set_ready_time :: Ptr Source -> -- _obj : TInterface "GLib" "Source" Int64 -> -- ready_time : TBasicType TInt64 IO () sourceSetReadyTime :: (MonadIO m) => Source -> -- _obj Int64 -> -- ready_time m () sourceSetReadyTime _obj ready_time = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_source_set_ready_time _obj' ready_time touchManagedPtr _obj return () -- method Source::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_unref" g_source_unref :: Ptr Source -> -- _obj : TInterface "GLib" "Source" IO () sourceUnref :: (MonadIO m) => Source -> -- _obj m () sourceUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_source_unref _obj' touchManagedPtr _obj return () -- struct SourceCallbackFuncs newtype SourceCallbackFuncs = SourceCallbackFuncs (ForeignPtr SourceCallbackFuncs) noSourceCallbackFuncs :: Maybe SourceCallbackFuncs noSourceCallbackFuncs = Nothing -- XXX Skipped getter for "SourceCallbackFuncs:ref" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "SourceCallbackFuncs:unref" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- callback SourceDummyMarshal sourceDummyMarshalClosure :: SourceDummyMarshal -> IO Closure sourceDummyMarshalClosure cb = newCClosure =<< mkSourceDummyMarshal wrapped where wrapped = sourceDummyMarshalWrapper Nothing cb type SourceDummyMarshalC = IO () foreign import ccall "wrapper" mkSourceDummyMarshal :: SourceDummyMarshalC -> IO (FunPtr SourceDummyMarshalC) type SourceDummyMarshal = IO () noSourceDummyMarshal :: Maybe SourceDummyMarshal noSourceDummyMarshal = Nothing sourceDummyMarshalWrapper :: Maybe (Ptr (FunPtr (SourceDummyMarshalC))) -> SourceDummyMarshal -> IO () sourceDummyMarshalWrapper funptrptr _cb = do _cb maybeReleaseFunPtr funptrptr -- callback SourceFunc sourceFuncClosure :: SourceFunc -> IO Closure sourceFuncClosure cb = newCClosure =<< mkSourceFunc wrapped where wrapped = sourceFuncWrapper Nothing cb type SourceFuncC = Ptr () -> IO CInt foreign import ccall "wrapper" mkSourceFunc :: SourceFuncC -> IO (FunPtr SourceFuncC) type SourceFunc = IO Bool noSourceFunc :: Maybe SourceFunc noSourceFunc = Nothing sourceFuncWrapper :: Maybe (Ptr (FunPtr (SourceFuncC))) -> SourceFunc -> Ptr () -> IO CInt sourceFuncWrapper funptrptr _cb _ = do result <- _cb maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- struct SourceFuncs newtype SourceFuncs = SourceFuncs (ForeignPtr SourceFuncs) noSourceFuncs :: Maybe SourceFuncs noSourceFuncs = Nothing -- XXX Skipped getter for "SourceFuncs:prepare" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "SourceFuncs:check" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "SourceFuncs:finalize" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- callback SpawnChildSetupFunc spawnChildSetupFuncClosure :: SpawnChildSetupFunc -> IO Closure spawnChildSetupFuncClosure cb = newCClosure =<< mkSpawnChildSetupFunc wrapped where wrapped = spawnChildSetupFuncWrapper Nothing cb type SpawnChildSetupFuncC = Ptr () -> IO () foreign import ccall "wrapper" mkSpawnChildSetupFunc :: SpawnChildSetupFuncC -> IO (FunPtr SpawnChildSetupFuncC) type SpawnChildSetupFunc = IO () noSpawnChildSetupFunc :: Maybe SpawnChildSetupFunc noSpawnChildSetupFunc = Nothing spawnChildSetupFuncWrapper :: Maybe (Ptr (FunPtr (SpawnChildSetupFuncC))) -> SpawnChildSetupFunc -> Ptr () -> IO () spawnChildSetupFuncWrapper funptrptr _cb _ = do _cb maybeReleaseFunPtr funptrptr -- Enum SpawnError data SpawnError = SpawnErrorFork | SpawnErrorRead | SpawnErrorChdir | SpawnErrorAcces | SpawnErrorPerm | SpawnErrorTooBig | SpawnError2big | SpawnErrorNoexec | SpawnErrorNametoolong | SpawnErrorNoent | SpawnErrorNomem | SpawnErrorNotdir | SpawnErrorLoop | SpawnErrorTxtbusy | SpawnErrorIo | SpawnErrorNfile | SpawnErrorMfile | SpawnErrorInval | SpawnErrorIsdir | SpawnErrorLibbad | SpawnErrorFailed | AnotherSpawnError Int deriving (Show, Eq) instance Enum SpawnError where fromEnum SpawnErrorFork = 0 fromEnum SpawnErrorRead = 1 fromEnum SpawnErrorChdir = 2 fromEnum SpawnErrorAcces = 3 fromEnum SpawnErrorPerm = 4 fromEnum SpawnErrorTooBig = 5 fromEnum SpawnError2big = 5 fromEnum SpawnErrorNoexec = 6 fromEnum SpawnErrorNametoolong = 7 fromEnum SpawnErrorNoent = 8 fromEnum SpawnErrorNomem = 9 fromEnum SpawnErrorNotdir = 10 fromEnum SpawnErrorLoop = 11 fromEnum SpawnErrorTxtbusy = 12 fromEnum SpawnErrorIo = 13 fromEnum SpawnErrorNfile = 14 fromEnum SpawnErrorMfile = 15 fromEnum SpawnErrorInval = 16 fromEnum SpawnErrorIsdir = 17 fromEnum SpawnErrorLibbad = 18 fromEnum SpawnErrorFailed = 19 fromEnum (AnotherSpawnError k) = k toEnum 0 = SpawnErrorFork toEnum 1 = SpawnErrorRead toEnum 2 = SpawnErrorChdir toEnum 3 = SpawnErrorAcces toEnum 4 = SpawnErrorPerm toEnum 5 = SpawnErrorTooBig toEnum 6 = SpawnErrorNoexec toEnum 7 = SpawnErrorNametoolong toEnum 8 = SpawnErrorNoent toEnum 9 = SpawnErrorNomem toEnum 10 = SpawnErrorNotdir toEnum 11 = SpawnErrorLoop toEnum 12 = SpawnErrorTxtbusy toEnum 13 = SpawnErrorIo toEnum 14 = SpawnErrorNfile toEnum 15 = SpawnErrorMfile toEnum 16 = SpawnErrorInval toEnum 17 = SpawnErrorIsdir toEnum 18 = SpawnErrorLibbad toEnum 19 = SpawnErrorFailed toEnum k = AnotherSpawnError k instance GErrorClass SpawnError where gerrorClassDomain _ = "g-exec-error-quark" catchSpawnError :: IO a -> (SpawnError -> GErrorMessage -> IO a) -> IO a catchSpawnError = catchGErrorJustDomain handleSpawnError :: (SpawnError -> GErrorMessage -> IO a) -> IO a -> IO a handleSpawnError = handleGErrorJustDomain -- Flags SpawnFlags data SpawnFlags = SpawnFlagsDefault | SpawnFlagsLeaveDescriptorsOpen | SpawnFlagsDoNotReapChild | SpawnFlagsSearchPath | SpawnFlagsStdoutToDevNull | SpawnFlagsStderrToDevNull | SpawnFlagsChildInheritsStdin | SpawnFlagsFileAndArgvZero | SpawnFlagsSearchPathFromEnvp | SpawnFlagsCloexecPipes | AnotherSpawnFlags Int deriving (Show, Eq) instance Enum SpawnFlags where fromEnum SpawnFlagsDefault = 0 fromEnum SpawnFlagsLeaveDescriptorsOpen = 1 fromEnum SpawnFlagsDoNotReapChild = 2 fromEnum SpawnFlagsSearchPath = 4 fromEnum SpawnFlagsStdoutToDevNull = 8 fromEnum SpawnFlagsStderrToDevNull = 16 fromEnum SpawnFlagsChildInheritsStdin = 32 fromEnum SpawnFlagsFileAndArgvZero = 64 fromEnum SpawnFlagsSearchPathFromEnvp = 128 fromEnum SpawnFlagsCloexecPipes = 256 fromEnum (AnotherSpawnFlags k) = k toEnum 0 = SpawnFlagsDefault toEnum 1 = SpawnFlagsLeaveDescriptorsOpen toEnum 2 = SpawnFlagsDoNotReapChild toEnum 4 = SpawnFlagsSearchPath toEnum 8 = SpawnFlagsStdoutToDevNull toEnum 16 = SpawnFlagsStderrToDevNull toEnum 32 = SpawnFlagsChildInheritsStdin toEnum 64 = SpawnFlagsFileAndArgvZero toEnum 128 = SpawnFlagsSearchPathFromEnvp toEnum 256 = SpawnFlagsCloexecPipes toEnum k = AnotherSpawnFlags k instance IsGFlag SpawnFlags -- struct StatBuf newtype StatBuf = StatBuf (ForeignPtr StatBuf) noStatBuf :: Maybe StatBuf noStatBuf = Nothing -- struct String newtype String = String (ForeignPtr String) noString :: Maybe String noString = Nothing foreign import ccall "g_gstring_get_type" c_g_gstring_get_type :: IO GType instance BoxedObject String where boxedType _ = c_g_gstring_get_type stringReadStr :: String -> IO T.Text stringReadStr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' stringReadLen :: String -> IO Word64 stringReadLen s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word64 return val stringReadAllocatedLen :: String -> IO Word64 stringReadAllocatedLen s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word64 return val -- method String::append -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_append" g_string_append :: Ptr String -> -- _obj : TInterface "GLib" "String" CString -> -- val : TBasicType TUTF8 IO (Ptr String) stringAppend :: (MonadIO m) => String -> -- _obj T.Text -> -- val m String stringAppend _obj val = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj val' <- textToCString val result <- g_string_append _obj' val' result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem val' return result' -- method String::append_c -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_append_c" g_string_append_c :: Ptr String -> -- _obj : TInterface "GLib" "String" Int8 -> -- c : TBasicType TInt8 IO (Ptr String) stringAppendC :: (MonadIO m) => String -> -- _obj Int8 -> -- c m String stringAppendC _obj c = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_append_c _obj' c result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::append_len -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_append_len" g_string_append_len :: Ptr String -> -- _obj : TInterface "GLib" "String" CString -> -- val : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO (Ptr String) stringAppendLen :: (MonadIO m) => String -> -- _obj T.Text -> -- val Int64 -> -- len m String stringAppendLen _obj val len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj val' <- textToCString val result <- g_string_append_len _obj' val' len result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem val' return result' -- method String::append_unichar -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_append_unichar" g_string_append_unichar :: Ptr String -> -- _obj : TInterface "GLib" "String" CInt -> -- wc : TBasicType TUniChar IO (Ptr String) stringAppendUnichar :: (MonadIO m) => String -> -- _obj Char -> -- wc m String stringAppendUnichar _obj wc = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let wc' = (fromIntegral . ord) wc result <- g_string_append_unichar _obj' wc' result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::append_uri_escaped -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "unescaped", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reserved_chars_allowed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_utf8", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "unescaped", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reserved_chars_allowed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_utf8", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_append_uri_escaped" g_string_append_uri_escaped :: Ptr String -> -- _obj : TInterface "GLib" "String" CString -> -- unescaped : TBasicType TUTF8 CString -> -- reserved_chars_allowed : TBasicType TUTF8 CInt -> -- allow_utf8 : TBasicType TBoolean IO (Ptr String) stringAppendUriEscaped :: (MonadIO m) => String -> -- _obj T.Text -> -- unescaped T.Text -> -- reserved_chars_allowed Bool -> -- allow_utf8 m String stringAppendUriEscaped _obj unescaped reserved_chars_allowed allow_utf8 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj unescaped' <- textToCString unescaped reserved_chars_allowed' <- textToCString reserved_chars_allowed let allow_utf8' = (fromIntegral . fromEnum) allow_utf8 result <- g_string_append_uri_escaped _obj' unescaped' reserved_chars_allowed' allow_utf8' result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem unescaped' freeMem reserved_chars_allowed' return result' -- method String::ascii_down -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_ascii_down" g_string_ascii_down :: Ptr String -> -- _obj : TInterface "GLib" "String" IO (Ptr String) stringAsciiDown :: (MonadIO m) => String -> -- _obj m String stringAsciiDown _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_ascii_down _obj' result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::ascii_up -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_ascii_up" g_string_ascii_up :: Ptr String -> -- _obj : TInterface "GLib" "String" IO (Ptr String) stringAsciiUp :: (MonadIO m) => String -> -- _obj m String stringAsciiUp _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_ascii_up _obj' result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::assign -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rval", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rval", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_assign" g_string_assign :: Ptr String -> -- _obj : TInterface "GLib" "String" CString -> -- rval : TBasicType TUTF8 IO (Ptr String) stringAssign :: (MonadIO m) => String -> -- _obj T.Text -> -- rval m String stringAssign _obj rval = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj rval' <- textToCString rval result <- g_string_assign _obj' rval' result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem rval' return result' -- method String::down -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_down" g_string_down :: Ptr String -> -- _obj : TInterface "GLib" "String" IO (Ptr String) {-# DEPRECATED stringDown ["(Since version 2.2)","This function uses the locale-specific"," tolower() function, which is almost never the right thing."," Use g_string_ascii_down() or g_utf8_strdown() instead."]#-} stringDown :: (MonadIO m) => String -> -- _obj m String stringDown _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_down _obj' result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_string_equal" g_string_equal :: Ptr String -> -- _obj : TInterface "GLib" "String" Ptr String -> -- v2 : TInterface "GLib" "String" IO CInt stringEqual :: (MonadIO m) => String -> -- _obj String -> -- v2 m Bool stringEqual _obj v2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let v2' = unsafeManagedPtrGetPtr v2 result <- g_string_equal _obj' v2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr v2 return result' -- method String::erase -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_erase" g_string_erase :: Ptr String -> -- _obj : TInterface "GLib" "String" Int64 -> -- pos : TBasicType TInt64 Int64 -> -- len : TBasicType TInt64 IO (Ptr String) stringErase :: (MonadIO m) => String -> -- _obj Int64 -> -- pos Int64 -> -- len m String stringErase _obj pos len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_erase _obj' pos len result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "free_segment", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "free_segment", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_string_free" g_string_free :: Ptr String -> -- _obj : TInterface "GLib" "String" CInt -> -- free_segment : TBasicType TBoolean IO CString stringFree :: (MonadIO m) => String -> -- _obj Bool -> -- free_segment m T.Text stringFree _obj free_segment = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let free_segment' = (fromIntegral . fromEnum) free_segment result <- g_string_free _obj' free_segment' result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method String::free_to_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : False -- Skip return : False foreign import ccall "g_string_free_to_bytes" g_string_free_to_bytes :: Ptr String -> -- _obj : TInterface "GLib" "String" IO (Ptr Bytes) stringFreeToBytes :: (MonadIO m) => String -> -- _obj m Bytes stringFreeToBytes _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_free_to_bytes _obj' result' <- (wrapBoxed Bytes) result touchManagedPtr _obj return result' -- method String::hash -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_string_hash" g_string_hash :: Ptr String -> -- _obj : TInterface "GLib" "String" IO Word32 stringHash :: (MonadIO m) => String -> -- _obj m Word32 stringHash _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_hash _obj' touchManagedPtr _obj return result -- method String::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_insert" g_string_insert :: Ptr String -> -- _obj : TInterface "GLib" "String" Int64 -> -- pos : TBasicType TInt64 CString -> -- val : TBasicType TUTF8 IO (Ptr String) stringInsert :: (MonadIO m) => String -> -- _obj Int64 -> -- pos T.Text -> -- val m String stringInsert _obj pos val = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj val' <- textToCString val result <- g_string_insert _obj' pos val' result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem val' return result' -- method String::insert_c -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_insert_c" g_string_insert_c :: Ptr String -> -- _obj : TInterface "GLib" "String" Int64 -> -- pos : TBasicType TInt64 Int8 -> -- c : TBasicType TInt8 IO (Ptr String) stringInsertC :: (MonadIO m) => String -> -- _obj Int64 -> -- pos Int8 -> -- c m String stringInsertC _obj pos c = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_insert_c _obj' pos c result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::insert_len -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_insert_len" g_string_insert_len :: Ptr String -> -- _obj : TInterface "GLib" "String" Int64 -> -- pos : TBasicType TInt64 CString -> -- val : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO (Ptr String) stringInsertLen :: (MonadIO m) => String -> -- _obj Int64 -> -- pos T.Text -> -- val Int64 -> -- len m String stringInsertLen _obj pos val len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj val' <- textToCString val result <- g_string_insert_len _obj' pos val' len result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem val' return result' -- method String::insert_unichar -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_insert_unichar" g_string_insert_unichar :: Ptr String -> -- _obj : TInterface "GLib" "String" Int64 -> -- pos : TBasicType TInt64 CInt -> -- wc : TBasicType TUniChar IO (Ptr String) stringInsertUnichar :: (MonadIO m) => String -> -- _obj Int64 -> -- pos Char -> -- wc m String stringInsertUnichar _obj pos wc = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let wc' = (fromIntegral . ord) wc result <- g_string_insert_unichar _obj' pos wc' result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::overwrite -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_overwrite" g_string_overwrite :: Ptr String -> -- _obj : TInterface "GLib" "String" Word64 -> -- pos : TBasicType TUInt64 CString -> -- val : TBasicType TUTF8 IO (Ptr String) stringOverwrite :: (MonadIO m) => String -> -- _obj Word64 -> -- pos T.Text -> -- val m String stringOverwrite _obj pos val = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj val' <- textToCString val result <- g_string_overwrite _obj' pos val' result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem val' return result' -- method String::overwrite_len -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_overwrite_len" g_string_overwrite_len :: Ptr String -> -- _obj : TInterface "GLib" "String" Word64 -> -- pos : TBasicType TUInt64 CString -> -- val : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO (Ptr String) stringOverwriteLen :: (MonadIO m) => String -> -- _obj Word64 -> -- pos T.Text -> -- val Int64 -> -- len m String stringOverwriteLen _obj pos val len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj val' <- textToCString val result <- g_string_overwrite_len _obj' pos val' len result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem val' return result' -- method String::prepend -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_prepend" g_string_prepend :: Ptr String -> -- _obj : TInterface "GLib" "String" CString -> -- val : TBasicType TUTF8 IO (Ptr String) stringPrepend :: (MonadIO m) => String -> -- _obj T.Text -> -- val m String stringPrepend _obj val = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj val' <- textToCString val result <- g_string_prepend _obj' val' result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem val' return result' -- method String::prepend_c -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_prepend_c" g_string_prepend_c :: Ptr String -> -- _obj : TInterface "GLib" "String" Int8 -> -- c : TBasicType TInt8 IO (Ptr String) stringPrependC :: (MonadIO m) => String -> -- _obj Int8 -> -- c m String stringPrependC _obj c = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_prepend_c _obj' c result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::prepend_len -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_prepend_len" g_string_prepend_len :: Ptr String -> -- _obj : TInterface "GLib" "String" CString -> -- val : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO (Ptr String) stringPrependLen :: (MonadIO m) => String -> -- _obj T.Text -> -- val Int64 -> -- len m String stringPrependLen _obj val len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj val' <- textToCString val result <- g_string_prepend_len _obj' val' len result' <- (wrapBoxed String) result touchManagedPtr _obj freeMem val' return result' -- method String::prepend_unichar -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_prepend_unichar" g_string_prepend_unichar :: Ptr String -> -- _obj : TInterface "GLib" "String" CInt -> -- wc : TBasicType TUniChar IO (Ptr String) stringPrependUnichar :: (MonadIO m) => String -> -- _obj Char -> -- wc m String stringPrependUnichar _obj wc = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let wc' = (fromIntegral . ord) wc result <- g_string_prepend_unichar _obj' wc' result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::set_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_set_size" g_string_set_size :: Ptr String -> -- _obj : TInterface "GLib" "String" Word64 -> -- len : TBasicType TUInt64 IO (Ptr String) stringSetSize :: (MonadIO m) => String -> -- _obj Word64 -> -- len m String stringSetSize _obj len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_set_size _obj' len result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::truncate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_truncate" g_string_truncate :: Ptr String -> -- _obj : TInterface "GLib" "String" Word64 -> -- len : TBasicType TUInt64 IO (Ptr String) stringTruncate :: (MonadIO m) => String -> -- _obj Word64 -> -- len m String stringTruncate _obj len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_truncate _obj' len result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- method String::up -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_up" g_string_up :: Ptr String -> -- _obj : TInterface "GLib" "String" IO (Ptr String) {-# DEPRECATED stringUp ["(Since version 2.2)","This function uses the locale-specific"," toupper() function, which is almost never the right thing."," Use g_string_ascii_up() or g_utf8_strup() instead."]#-} stringUp :: (MonadIO m) => String -> -- _obj m String stringUp _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_string_up _obj' result' <- (wrapBoxed String) result touchManagedPtr _obj return result' -- struct StringChunk newtype StringChunk = StringChunk (ForeignPtr StringChunk) noStringChunk :: Maybe StringChunk noStringChunk = Nothing -- method StringChunk::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_string_chunk_clear" g_string_chunk_clear :: Ptr StringChunk -> -- _obj : TInterface "GLib" "StringChunk" IO () stringChunkClear :: (MonadIO m) => StringChunk -> -- _obj m () stringChunkClear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_string_chunk_clear _obj' touchManagedPtr _obj return () -- method StringChunk::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_string_chunk_free" g_string_chunk_free :: Ptr StringChunk -> -- _obj : TInterface "GLib" "StringChunk" IO () stringChunkFree :: (MonadIO m) => StringChunk -> -- _obj m () stringChunkFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_string_chunk_free _obj' touchManagedPtr _obj return () -- method StringChunk::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_string_chunk_insert" g_string_chunk_insert :: Ptr StringChunk -> -- _obj : TInterface "GLib" "StringChunk" CString -> -- string : TBasicType TUTF8 IO CString stringChunkInsert :: (MonadIO m) => StringChunk -> -- _obj T.Text -> -- string m T.Text stringChunkInsert _obj string = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string' <- textToCString string result <- g_string_chunk_insert _obj' string' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem string' return result' -- method StringChunk::insert_const -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_string_chunk_insert_const" g_string_chunk_insert_const :: Ptr StringChunk -> -- _obj : TInterface "GLib" "StringChunk" CString -> -- string : TBasicType TUTF8 IO CString stringChunkInsertConst :: (MonadIO m) => StringChunk -> -- _obj T.Text -> -- string m T.Text stringChunkInsertConst _obj string = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string' <- textToCString string result <- g_string_chunk_insert_const _obj' string' result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem string' return result' -- method StringChunk::insert_len -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "StringChunk", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_string_chunk_insert_len" g_string_chunk_insert_len :: Ptr StringChunk -> -- _obj : TInterface "GLib" "StringChunk" CString -> -- string : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString stringChunkInsertLen :: (MonadIO m) => StringChunk -> -- _obj T.Text -> -- string Int64 -> -- len m T.Text stringChunkInsertLen _obj string len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string' <- textToCString string result <- g_string_chunk_insert_len _obj' string' len result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem string' return result' -- struct TestCase newtype TestCase = TestCase (ForeignPtr TestCase) noTestCase :: Maybe TestCase noTestCase = Nothing -- struct TestConfig newtype TestConfig = TestConfig (ForeignPtr TestConfig) noTestConfig :: Maybe TestConfig noTestConfig = Nothing testConfigReadTestInitialized :: TestConfig -> IO Bool testConfigReadTestInitialized s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CInt let val' = (/= 0) val return val' testConfigReadTestQuick :: TestConfig -> IO Bool testConfigReadTestQuick s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO CInt let val' = (/= 0) val return val' testConfigReadTestPerf :: TestConfig -> IO Bool testConfigReadTestPerf s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CInt let val' = (/= 0) val return val' testConfigReadTestVerbose :: TestConfig -> IO Bool testConfigReadTestVerbose s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO CInt let val' = (/= 0) val return val' testConfigReadTestQuiet :: TestConfig -> IO Bool testConfigReadTestQuiet s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CInt let val' = (/= 0) val return val' testConfigReadTestUndefined :: TestConfig -> IO Bool testConfigReadTestUndefined s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO CInt let val' = (/= 0) val return val' -- callback TestDataFunc testDataFuncClosure :: TestDataFunc -> IO Closure testDataFuncClosure cb = newCClosure =<< mkTestDataFunc wrapped where wrapped = testDataFuncWrapper Nothing cb type TestDataFuncC = Ptr () -> IO () foreign import ccall "wrapper" mkTestDataFunc :: TestDataFuncC -> IO (FunPtr TestDataFuncC) type TestDataFunc = IO () noTestDataFunc :: Maybe TestDataFunc noTestDataFunc = Nothing testDataFuncWrapper :: Maybe (Ptr (FunPtr (TestDataFuncC))) -> TestDataFunc -> Ptr () -> IO () testDataFuncWrapper funptrptr _cb _ = do _cb maybeReleaseFunPtr funptrptr -- Enum TestFileType data TestFileType = TestFileTypeDist | TestFileTypeBuilt | AnotherTestFileType Int deriving (Show, Eq) instance Enum TestFileType where fromEnum TestFileTypeDist = 0 fromEnum TestFileTypeBuilt = 1 fromEnum (AnotherTestFileType k) = k toEnum 0 = TestFileTypeDist toEnum 1 = TestFileTypeBuilt toEnum k = AnotherTestFileType k -- callback TestFixtureFunc testFixtureFuncClosure :: TestFixtureFunc -> IO Closure testFixtureFuncClosure cb = newCClosure =<< mkTestFixtureFunc wrapped where wrapped = testFixtureFuncWrapper Nothing cb type TestFixtureFuncC = Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkTestFixtureFunc :: TestFixtureFuncC -> IO (FunPtr TestFixtureFuncC) type TestFixtureFunc = Ptr () -> IO () noTestFixtureFunc :: Maybe TestFixtureFunc noTestFixtureFunc = Nothing testFixtureFuncWrapper :: Maybe (Ptr (FunPtr (TestFixtureFuncC))) -> TestFixtureFunc -> Ptr () -> Ptr () -> IO () testFixtureFuncWrapper funptrptr _cb fixture _ = do _cb fixture maybeReleaseFunPtr funptrptr -- callback TestFunc testFuncClosure :: TestFunc -> IO Closure testFuncClosure cb = newCClosure =<< mkTestFunc wrapped where wrapped = testFuncWrapper Nothing cb type TestFuncC = IO () foreign import ccall "wrapper" mkTestFunc :: TestFuncC -> IO (FunPtr TestFuncC) type TestFunc = IO () noTestFunc :: Maybe TestFunc noTestFunc = Nothing testFuncWrapper :: Maybe (Ptr (FunPtr (TestFuncC))) -> TestFunc -> IO () testFuncWrapper funptrptr _cb = do _cb maybeReleaseFunPtr funptrptr -- struct TestLogBuffer newtype TestLogBuffer = TestLogBuffer (ForeignPtr TestLogBuffer) noTestLogBuffer :: Maybe TestLogBuffer noTestLogBuffer = Nothing -- method TestLogBuffer::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TestLogBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TestLogBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_log_buffer_free" g_test_log_buffer_free :: Ptr TestLogBuffer -> -- _obj : TInterface "GLib" "TestLogBuffer" IO () testLogBufferFree :: (MonadIO m) => TestLogBuffer -> -- _obj m () testLogBufferFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_test_log_buffer_free _obj' touchManagedPtr _obj return () -- method TestLogBuffer::push -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TestLogBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_bytes", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TestLogBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_bytes", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_log_buffer_push" g_test_log_buffer_push :: Ptr TestLogBuffer -> -- _obj : TInterface "GLib" "TestLogBuffer" Word32 -> -- n_bytes : TBasicType TUInt32 Word8 -> -- bytes : TBasicType TUInt8 IO () testLogBufferPush :: (MonadIO m) => TestLogBuffer -> -- _obj Word32 -> -- n_bytes Word8 -> -- bytes m () testLogBufferPush _obj n_bytes bytes = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_test_log_buffer_push _obj' n_bytes bytes touchManagedPtr _obj return () -- callback TestLogFatalFunc testLogFatalFuncClosure :: TestLogFatalFunc -> IO Closure testLogFatalFuncClosure cb = newCClosure =<< mkTestLogFatalFunc wrapped where wrapped = testLogFatalFuncWrapper Nothing cb type TestLogFatalFuncC = CString -> CUInt -> CString -> Ptr () -> IO CInt foreign import ccall "wrapper" mkTestLogFatalFunc :: TestLogFatalFuncC -> IO (FunPtr TestLogFatalFuncC) type TestLogFatalFunc = T.Text -> [LogLevelFlags] -> T.Text -> IO Bool noTestLogFatalFunc :: Maybe TestLogFatalFunc noTestLogFatalFunc = Nothing testLogFatalFuncWrapper :: Maybe (Ptr (FunPtr (TestLogFatalFuncC))) -> TestLogFatalFunc -> CString -> CUInt -> CString -> Ptr () -> IO CInt testLogFatalFuncWrapper funptrptr _cb log_domain log_level message _ = do log_domain' <- cstringToText log_domain let log_level' = wordToGFlags log_level message' <- cstringToText message result <- _cb log_domain' log_level' message' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- struct TestLogMsg newtype TestLogMsg = TestLogMsg (ForeignPtr TestLogMsg) noTestLogMsg :: Maybe TestLogMsg noTestLogMsg = Nothing testLogMsgReadLogType :: TestLogMsg -> IO TestLogType testLogMsgReadLogType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' testLogMsgReadNStrings :: TestLogMsg -> IO Word32 testLogMsgReadNStrings s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word32 return val testLogMsgReadStrings :: TestLogMsg -> IO T.Text testLogMsgReadStrings s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' testLogMsgReadNNums :: TestLogMsg -> IO Word32 testLogMsgReadNNums s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word32 return val testLogMsgReadNums :: TestLogMsg -> IO Int64 testLogMsgReadNums s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Int64 return val -- method TestLogMsg::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TestLogMsg", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TestLogMsg", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_log_msg_free" g_test_log_msg_free :: Ptr TestLogMsg -> -- _obj : TInterface "GLib" "TestLogMsg" IO () testLogMsgFree :: (MonadIO m) => TestLogMsg -> -- _obj m () testLogMsgFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_test_log_msg_free _obj' touchManagedPtr _obj return () -- Enum TestLogType data TestLogType = TestLogTypeNone | TestLogTypeError | TestLogTypeStartBinary | TestLogTypeListCase | TestLogTypeSkipCase | TestLogTypeStartCase | TestLogTypeStopCase | TestLogTypeMinResult | TestLogTypeMaxResult | TestLogTypeMessage | TestLogTypeStartSuite | TestLogTypeStopSuite | AnotherTestLogType Int deriving (Show, Eq) instance Enum TestLogType where fromEnum TestLogTypeNone = 0 fromEnum TestLogTypeError = 1 fromEnum TestLogTypeStartBinary = 2 fromEnum TestLogTypeListCase = 3 fromEnum TestLogTypeSkipCase = 4 fromEnum TestLogTypeStartCase = 5 fromEnum TestLogTypeStopCase = 6 fromEnum TestLogTypeMinResult = 7 fromEnum TestLogTypeMaxResult = 8 fromEnum TestLogTypeMessage = 9 fromEnum TestLogTypeStartSuite = 10 fromEnum TestLogTypeStopSuite = 11 fromEnum (AnotherTestLogType k) = k toEnum 0 = TestLogTypeNone toEnum 1 = TestLogTypeError toEnum 2 = TestLogTypeStartBinary toEnum 3 = TestLogTypeListCase toEnum 4 = TestLogTypeSkipCase toEnum 5 = TestLogTypeStartCase toEnum 6 = TestLogTypeStopCase toEnum 7 = TestLogTypeMinResult toEnum 8 = TestLogTypeMaxResult toEnum 9 = TestLogTypeMessage toEnum 10 = TestLogTypeStartSuite toEnum 11 = TestLogTypeStopSuite toEnum k = AnotherTestLogType k -- Flags TestSubprocessFlags data TestSubprocessFlags = TestSubprocessFlagsStdin | TestSubprocessFlagsStdout | TestSubprocessFlagsStderr | AnotherTestSubprocessFlags Int deriving (Show, Eq) instance Enum TestSubprocessFlags where fromEnum TestSubprocessFlagsStdin = 1 fromEnum TestSubprocessFlagsStdout = 2 fromEnum TestSubprocessFlagsStderr = 4 fromEnum (AnotherTestSubprocessFlags k) = k toEnum 1 = TestSubprocessFlagsStdin toEnum 2 = TestSubprocessFlagsStdout toEnum 4 = TestSubprocessFlagsStderr toEnum k = AnotherTestSubprocessFlags k instance IsGFlag TestSubprocessFlags -- struct TestSuite newtype TestSuite = TestSuite (ForeignPtr TestSuite) noTestSuite :: Maybe TestSuite noTestSuite = Nothing -- method TestSuite::add -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TestSuite", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_case", argType = TInterface "GLib" "TestCase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TestSuite", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_case", argType = TInterface "GLib" "TestCase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_suite_add" g_test_suite_add :: Ptr TestSuite -> -- _obj : TInterface "GLib" "TestSuite" Ptr TestCase -> -- test_case : TInterface "GLib" "TestCase" IO () testSuiteAdd :: (MonadIO m) => TestSuite -> -- _obj TestCase -> -- test_case m () testSuiteAdd _obj test_case = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let test_case' = unsafeManagedPtrGetPtr test_case g_test_suite_add _obj' test_case' touchManagedPtr _obj touchManagedPtr test_case return () -- method TestSuite::add_suite -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TestSuite", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nestedsuite", argType = TInterface "GLib" "TestSuite", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TestSuite", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nestedsuite", argType = TInterface "GLib" "TestSuite", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_suite_add_suite" g_test_suite_add_suite :: Ptr TestSuite -> -- _obj : TInterface "GLib" "TestSuite" Ptr TestSuite -> -- nestedsuite : TInterface "GLib" "TestSuite" IO () testSuiteAddSuite :: (MonadIO m) => TestSuite -> -- _obj TestSuite -> -- nestedsuite m () testSuiteAddSuite _obj nestedsuite = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let nestedsuite' = unsafeManagedPtrGetPtr nestedsuite g_test_suite_add_suite _obj' nestedsuite' touchManagedPtr _obj touchManagedPtr nestedsuite return () -- Flags TestTrapFlags {-# DEPRECATED TestTrapFlags ["#GTestTrapFlags is used only with g_test_trap_fork(),","which is deprecated. g_test_trap_subprocess() uses","#GTestTrapSubprocessFlags."]#-} data TestTrapFlags = TestTrapFlagsSilenceStdout | TestTrapFlagsSilenceStderr | TestTrapFlagsInheritStdin | AnotherTestTrapFlags Int deriving (Show, Eq) instance Enum TestTrapFlags where fromEnum TestTrapFlagsSilenceStdout = 128 fromEnum TestTrapFlagsSilenceStderr = 256 fromEnum TestTrapFlagsInheritStdin = 512 fromEnum (AnotherTestTrapFlags k) = k toEnum 128 = TestTrapFlagsSilenceStdout toEnum 256 = TestTrapFlagsSilenceStderr toEnum 512 = TestTrapFlagsInheritStdin toEnum k = AnotherTestTrapFlags k instance IsGFlag TestTrapFlags -- struct Thread newtype Thread = Thread (ForeignPtr Thread) noThread :: Maybe Thread noThread = Nothing foreign import ccall "g_thread_get_type" c_g_thread_get_type :: IO GType instance BoxedObject Thread where boxedType _ = c_g_thread_get_type -- method Thread::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Thread", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Thread", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Thread" -- throws : False -- Skip return : False foreign import ccall "g_thread_ref" g_thread_ref :: Ptr Thread -> -- _obj : TInterface "GLib" "Thread" IO (Ptr Thread) threadRef :: (MonadIO m) => Thread -> -- _obj m Thread threadRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_thread_ref _obj' result' <- (wrapBoxed Thread) result touchManagedPtr _obj return result' -- method Thread::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Thread", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Thread", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_thread_unref" g_thread_unref :: Ptr Thread -> -- _obj : TInterface "GLib" "Thread" IO () threadUnref :: (MonadIO m) => Thread -> -- _obj m () threadUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_thread_unref _obj' touchManagedPtr _obj return () -- Enum ThreadError data ThreadError = ThreadErrorThreadErrorAgain | AnotherThreadError Int deriving (Show, Eq) instance Enum ThreadError where fromEnum ThreadErrorThreadErrorAgain = 0 fromEnum (AnotherThreadError k) = k toEnum 0 = ThreadErrorThreadErrorAgain toEnum k = AnotherThreadError k instance GErrorClass ThreadError where gerrorClassDomain _ = "g_thread_error" catchThreadError :: IO a -> (ThreadError -> GErrorMessage -> IO a) -> IO a catchThreadError = catchGErrorJustDomain handleThreadError :: (ThreadError -> GErrorMessage -> IO a) -> IO a -> IO a handleThreadError = handleGErrorJustDomain -- struct ThreadPool newtype ThreadPool = ThreadPool (ForeignPtr ThreadPool) noThreadPool :: Maybe ThreadPool noThreadPool = Nothing -- XXX Skipped getter for "ThreadPool:func" :: Not implemented: "Wrapping foreign callbacks is not supported yet" threadPoolReadUserData :: ThreadPool -> IO (Ptr ()) threadPoolReadUserData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr ()) return val threadPoolReadExclusive :: ThreadPool -> IO Bool threadPoolReadExclusive s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CInt let val' = (/= 0) val return val' -- method ThreadPool::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "immediate", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wait_", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "immediate", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wait_", 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_thread_pool_free" g_thread_pool_free :: Ptr ThreadPool -> -- _obj : TInterface "GLib" "ThreadPool" CInt -> -- immediate : TBasicType TBoolean CInt -> -- wait_ : TBasicType TBoolean IO () threadPoolFree :: (MonadIO m) => ThreadPool -> -- _obj Bool -> -- immediate Bool -> -- wait_ m () threadPoolFree _obj immediate wait_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let immediate' = (fromIntegral . fromEnum) immediate let wait_' = (fromIntegral . fromEnum) wait_ g_thread_pool_free _obj' immediate' wait_' touchManagedPtr _obj return () -- method ThreadPool::get_max_threads -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_thread_pool_get_max_threads" g_thread_pool_get_max_threads :: Ptr ThreadPool -> -- _obj : TInterface "GLib" "ThreadPool" IO Int32 threadPoolGetMaxThreads :: (MonadIO m) => ThreadPool -> -- _obj m Int32 threadPoolGetMaxThreads _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_thread_pool_get_max_threads _obj' touchManagedPtr _obj return result -- method ThreadPool::get_num_threads -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_thread_pool_get_num_threads" g_thread_pool_get_num_threads :: Ptr ThreadPool -> -- _obj : TInterface "GLib" "ThreadPool" IO Word32 threadPoolGetNumThreads :: (MonadIO m) => ThreadPool -> -- _obj m Word32 threadPoolGetNumThreads _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_thread_pool_get_num_threads _obj' touchManagedPtr _obj return result -- method ThreadPool::push -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_thread_pool_push" g_thread_pool_push :: Ptr ThreadPool -> -- _obj : TInterface "GLib" "ThreadPool" Ptr () -> -- data : TBasicType TVoid Ptr (Ptr GError) -> -- error IO CInt threadPoolPush :: (MonadIO m) => ThreadPool -> -- _obj Ptr () -> -- data m () threadPoolPush _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj onException (do _ <- propagateGError $ g_thread_pool_push _obj' data_ touchManagedPtr _obj return () ) (do return () ) -- method ThreadPool::set_max_threads -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_threads", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_threads", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_thread_pool_set_max_threads" g_thread_pool_set_max_threads :: Ptr ThreadPool -> -- _obj : TInterface "GLib" "ThreadPool" Int32 -> -- max_threads : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt threadPoolSetMaxThreads :: (MonadIO m) => ThreadPool -> -- _obj Int32 -> -- max_threads m () threadPoolSetMaxThreads _obj max_threads = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj onException (do _ <- propagateGError $ g_thread_pool_set_max_threads _obj' max_threads touchManagedPtr _obj return () ) (do return () ) -- method ThreadPool::unprocessed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "ThreadPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_thread_pool_unprocessed" g_thread_pool_unprocessed :: Ptr ThreadPool -> -- _obj : TInterface "GLib" "ThreadPool" IO Word32 threadPoolUnprocessed :: (MonadIO m) => ThreadPool -> -- _obj m Word32 threadPoolUnprocessed _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_thread_pool_unprocessed _obj' touchManagedPtr _obj return result -- Enum TimeType data TimeType = TimeTypeStandard | TimeTypeDaylight | TimeTypeUniversal | AnotherTimeType Int deriving (Show, Eq) instance Enum TimeType where fromEnum TimeTypeStandard = 0 fromEnum TimeTypeDaylight = 1 fromEnum TimeTypeUniversal = 2 fromEnum (AnotherTimeType k) = k toEnum 0 = TimeTypeStandard toEnum 1 = TimeTypeDaylight toEnum 2 = TimeTypeUniversal toEnum k = AnotherTimeType k -- struct TimeVal newtype TimeVal = TimeVal (ForeignPtr TimeVal) noTimeVal :: Maybe TimeVal noTimeVal = Nothing timeValReadTvSec :: TimeVal -> IO Int64 timeValReadTvSec s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int64 return val timeValReadTvUsec :: TimeVal -> IO Int64 timeValReadTvUsec s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int64 return val -- method TimeVal::add -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "microseconds", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "microseconds", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_time_val_add" g_time_val_add :: Ptr TimeVal -> -- _obj : TInterface "GLib" "TimeVal" Int64 -> -- microseconds : TBasicType TInt64 IO () timeValAdd :: (MonadIO m) => TimeVal -> -- _obj Int64 -> -- microseconds m () timeValAdd _obj microseconds = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_time_val_add _obj' microseconds touchManagedPtr _obj return () -- method TimeVal::to_iso8601 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_time_val_to_iso8601" g_time_val_to_iso8601 :: Ptr TimeVal -> -- _obj : TInterface "GLib" "TimeVal" IO CString timeValToIso8601 :: (MonadIO m) => TimeVal -> -- _obj m T.Text timeValToIso8601 _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_time_val_to_iso8601 _obj' result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- struct TimeZone newtype TimeZone = TimeZone (ForeignPtr TimeZone) noTimeZone :: Maybe TimeZone noTimeZone = Nothing foreign import ccall "g_time_zone_get_type" c_g_time_zone_get_type :: IO GType instance BoxedObject TimeZone where boxedType _ = c_g_time_zone_get_type -- method TimeZone::new -- method type : Constructor -- Args : [Arg {argName = "identifier", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "identifier", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "TimeZone" -- throws : False -- Skip return : False foreign import ccall "g_time_zone_new" g_time_zone_new :: CString -> -- identifier : TBasicType TUTF8 IO (Ptr TimeZone) timeZoneNew :: (MonadIO m) => Maybe (T.Text) -> -- identifier m TimeZone timeZoneNew identifier = liftIO $ do maybeIdentifier <- case identifier of Nothing -> return nullPtr Just jIdentifier -> do jIdentifier' <- textToCString jIdentifier return jIdentifier' result <- g_time_zone_new maybeIdentifier result' <- (wrapBoxed TimeZone) result freeMem maybeIdentifier return result' -- method TimeZone::new_local -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "TimeZone" -- throws : False -- Skip return : False foreign import ccall "g_time_zone_new_local" g_time_zone_new_local :: IO (Ptr TimeZone) timeZoneNewLocal :: (MonadIO m) => m TimeZone timeZoneNewLocal = liftIO $ do result <- g_time_zone_new_local result' <- (wrapBoxed TimeZone) result return result' -- method TimeZone::new_utc -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "TimeZone" -- throws : False -- Skip return : False foreign import ccall "g_time_zone_new_utc" g_time_zone_new_utc :: IO (Ptr TimeZone) timeZoneNewUtc :: (MonadIO m) => m TimeZone timeZoneNewUtc = liftIO $ do result <- g_time_zone_new_utc result' <- (wrapBoxed TimeZone) result return result' -- method TimeZone::adjust_time -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "TimeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "time_", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "TimeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "time_", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_time_zone_adjust_time" g_time_zone_adjust_time :: Ptr TimeZone -> -- _obj : TInterface "GLib" "TimeZone" CUInt -> -- type : TInterface "GLib" "TimeType" Int64 -> -- time_ : TBasicType TInt64 IO Int32 timeZoneAdjustTime :: (MonadIO m) => TimeZone -> -- _obj TimeType -> -- type Int64 -> -- time_ m Int32 timeZoneAdjustTime _obj type_ time_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let type_' = (fromIntegral . fromEnum) type_ result <- g_time_zone_adjust_time _obj' type_' time_ touchManagedPtr _obj return result -- method TimeZone::find_interval -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "TimeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "time_", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "TimeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "time_", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_time_zone_find_interval" g_time_zone_find_interval :: Ptr TimeZone -> -- _obj : TInterface "GLib" "TimeZone" CUInt -> -- type : TInterface "GLib" "TimeType" Int64 -> -- time_ : TBasicType TInt64 IO Int32 timeZoneFindInterval :: (MonadIO m) => TimeZone -> -- _obj TimeType -> -- type Int64 -> -- time_ m Int32 timeZoneFindInterval _obj type_ time_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let type_' = (fromIntegral . fromEnum) type_ result <- g_time_zone_find_interval _obj' type_' time_ touchManagedPtr _obj return result -- method TimeZone::get_abbreviation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", 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_time_zone_get_abbreviation" g_time_zone_get_abbreviation :: Ptr TimeZone -> -- _obj : TInterface "GLib" "TimeZone" Int32 -> -- interval : TBasicType TInt32 IO CString timeZoneGetAbbreviation :: (MonadIO m) => TimeZone -> -- _obj Int32 -> -- interval m T.Text timeZoneGetAbbreviation _obj interval = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_time_zone_get_abbreviation _obj' interval result' <- cstringToText result touchManagedPtr _obj return result' -- method TimeZone::get_offset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_time_zone_get_offset" g_time_zone_get_offset :: Ptr TimeZone -> -- _obj : TInterface "GLib" "TimeZone" Int32 -> -- interval : TBasicType TInt32 IO Int32 timeZoneGetOffset :: (MonadIO m) => TimeZone -> -- _obj Int32 -> -- interval m Int32 timeZoneGetOffset _obj interval = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_time_zone_get_offset _obj' interval touchManagedPtr _obj return result -- method TimeZone::is_dst -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_time_zone_is_dst" g_time_zone_is_dst :: Ptr TimeZone -> -- _obj : TInterface "GLib" "TimeZone" Int32 -> -- interval : TBasicType TInt32 IO CInt timeZoneIsDst :: (MonadIO m) => TimeZone -> -- _obj Int32 -> -- interval m Bool timeZoneIsDst _obj interval = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_time_zone_is_dst _obj' interval let result' = (/= 0) result touchManagedPtr _obj return result' -- method TimeZone::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "TimeZone" -- throws : False -- Skip return : False foreign import ccall "g_time_zone_ref" g_time_zone_ref :: Ptr TimeZone -> -- _obj : TInterface "GLib" "TimeZone" IO (Ptr TimeZone) timeZoneRef :: (MonadIO m) => TimeZone -> -- _obj m TimeZone timeZoneRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_time_zone_ref _obj' result' <- (wrapBoxed TimeZone) result touchManagedPtr _obj return result' -- method TimeZone::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "TimeZone", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_time_zone_unref" g_time_zone_unref :: Ptr TimeZone -> -- _obj : TInterface "GLib" "TimeZone" IO () timeZoneUnref :: (MonadIO m) => TimeZone -> -- _obj m () timeZoneUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_time_zone_unref _obj' touchManagedPtr _obj return () -- struct Timer newtype Timer = Timer (ForeignPtr Timer) noTimer :: Maybe Timer noTimer = Nothing -- method Timer::continue -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_timer_continue" g_timer_continue :: Ptr Timer -> -- _obj : TInterface "GLib" "Timer" IO () timerContinue :: (MonadIO m) => Timer -> -- _obj m () timerContinue _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_timer_continue _obj' touchManagedPtr _obj return () -- method Timer::destroy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_timer_destroy" g_timer_destroy :: Ptr Timer -> -- _obj : TInterface "GLib" "Timer" IO () timerDestroy :: (MonadIO m) => Timer -> -- _obj m () timerDestroy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_timer_destroy _obj' touchManagedPtr _obj return () -- method Timer::elapsed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "microseconds", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "microseconds", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_timer_elapsed" g_timer_elapsed :: Ptr Timer -> -- _obj : TInterface "GLib" "Timer" Word64 -> -- microseconds : TBasicType TUInt64 IO CDouble timerElapsed :: (MonadIO m) => Timer -> -- _obj Word64 -> -- microseconds m Double timerElapsed _obj microseconds = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_timer_elapsed _obj' microseconds let result' = realToFrac result touchManagedPtr _obj return result' -- method Timer::reset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_timer_reset" g_timer_reset :: Ptr Timer -> -- _obj : TInterface "GLib" "Timer" IO () timerReset :: (MonadIO m) => Timer -> -- _obj m () timerReset _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_timer_reset _obj' touchManagedPtr _obj return () -- method Timer::start -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_timer_start" g_timer_start :: Ptr Timer -> -- _obj : TInterface "GLib" "Timer" IO () timerStart :: (MonadIO m) => Timer -> -- _obj m () timerStart _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_timer_start _obj' touchManagedPtr _obj return () -- method Timer::stop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Timer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_timer_stop" g_timer_stop :: Ptr Timer -> -- _obj : TInterface "GLib" "Timer" IO () timerStop :: (MonadIO m) => Timer -> -- _obj m () timerStop _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_timer_stop _obj' touchManagedPtr _obj return () -- Enum TokenType data TokenType = TokenTypeEof | TokenTypeLeftParen | TokenTypeRightParen | TokenTypeLeftCurly | TokenTypeRightCurly | TokenTypeLeftBrace | TokenTypeRightBrace | TokenTypeEqualSign | TokenTypeComma | TokenTypeNone | TokenTypeError | TokenTypeChar | TokenTypeBinary | TokenTypeOctal | TokenTypeInt | TokenTypeHex | TokenTypeFloat | TokenTypeString | TokenTypeSymbol | TokenTypeIdentifier | TokenTypeIdentifierNull | TokenTypeCommentSingle | TokenTypeCommentMulti | AnotherTokenType Int deriving (Show, Eq) instance Enum TokenType where fromEnum TokenTypeEof = 0 fromEnum TokenTypeLeftParen = 40 fromEnum TokenTypeRightParen = 41 fromEnum TokenTypeLeftCurly = 123 fromEnum TokenTypeRightCurly = 125 fromEnum TokenTypeLeftBrace = 91 fromEnum TokenTypeRightBrace = 93 fromEnum TokenTypeEqualSign = 61 fromEnum TokenTypeComma = 44 fromEnum TokenTypeNone = 256 fromEnum TokenTypeError = 257 fromEnum TokenTypeChar = 258 fromEnum TokenTypeBinary = 259 fromEnum TokenTypeOctal = 260 fromEnum TokenTypeInt = 261 fromEnum TokenTypeHex = 262 fromEnum TokenTypeFloat = 263 fromEnum TokenTypeString = 264 fromEnum TokenTypeSymbol = 265 fromEnum TokenTypeIdentifier = 266 fromEnum TokenTypeIdentifierNull = 267 fromEnum TokenTypeCommentSingle = 268 fromEnum TokenTypeCommentMulti = 269 fromEnum (AnotherTokenType k) = k toEnum 0 = TokenTypeEof toEnum 40 = TokenTypeLeftParen toEnum 41 = TokenTypeRightParen toEnum 44 = TokenTypeComma toEnum 61 = TokenTypeEqualSign toEnum 91 = TokenTypeLeftBrace toEnum 93 = TokenTypeRightBrace toEnum 123 = TokenTypeLeftCurly toEnum 125 = TokenTypeRightCurly toEnum 256 = TokenTypeNone toEnum 257 = TokenTypeError toEnum 258 = TokenTypeChar toEnum 259 = TokenTypeBinary toEnum 260 = TokenTypeOctal toEnum 261 = TokenTypeInt toEnum 262 = TokenTypeHex toEnum 263 = TokenTypeFloat toEnum 264 = TokenTypeString toEnum 265 = TokenTypeSymbol toEnum 266 = TokenTypeIdentifier toEnum 267 = TokenTypeIdentifierNull toEnum 268 = TokenTypeCommentSingle toEnum 269 = TokenTypeCommentMulti toEnum k = AnotherTokenType k -- union TokenValue newtype TokenValue = TokenValue (ForeignPtr TokenValue) noTokenValue :: Maybe TokenValue noTokenValue = Nothing tokenValueReadVSymbol :: TokenValue -> IO (Ptr ()) tokenValueReadVSymbol s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val tokenValueReadVIdentifier :: TokenValue -> IO T.Text tokenValueReadVIdentifier s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' tokenValueReadVBinary :: TokenValue -> IO Word64 tokenValueReadVBinary s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word64 return val tokenValueReadVOctal :: TokenValue -> IO Word64 tokenValueReadVOctal s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word64 return val tokenValueReadVInt :: TokenValue -> IO Word64 tokenValueReadVInt s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word64 return val tokenValueReadVInt64 :: TokenValue -> IO Word64 tokenValueReadVInt64 s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word64 return val tokenValueReadVFloat :: TokenValue -> IO Double tokenValueReadVFloat s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CDouble let val' = realToFrac val return val' tokenValueReadVHex :: TokenValue -> IO Word64 tokenValueReadVHex s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word64 return val tokenValueReadVString :: TokenValue -> IO T.Text tokenValueReadVString s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' tokenValueReadVComment :: TokenValue -> IO T.Text tokenValueReadVComment s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' tokenValueReadVChar :: TokenValue -> IO Word8 tokenValueReadVChar s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word8 return val tokenValueReadVError :: TokenValue -> IO Word32 tokenValueReadVError s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val -- callback TranslateFunc translateFuncClosure :: TranslateFunc -> IO Closure translateFuncClosure cb = newCClosure =<< mkTranslateFunc wrapped where wrapped = translateFuncWrapper Nothing cb type TranslateFuncC = CString -> Ptr () -> IO CString foreign import ccall "wrapper" mkTranslateFunc :: TranslateFuncC -> IO (FunPtr TranslateFuncC) type TranslateFunc = T.Text -> Ptr () -> IO T.Text noTranslateFunc :: Maybe TranslateFunc noTranslateFunc = Nothing translateFuncWrapper :: Maybe (Ptr (FunPtr (TranslateFuncC))) -> TranslateFunc -> CString -> Ptr () -> IO CString translateFuncWrapper funptrptr _cb str data_ = do str' <- cstringToText str result <- _cb str' data_ maybeReleaseFunPtr funptrptr result' <- textToCString result return result' -- struct TrashStack newtype TrashStack = TrashStack (ForeignPtr TrashStack) noTrashStack :: Maybe TrashStack noTrashStack = Nothing trashStackReadNext :: TrashStack -> IO TrashStack trashStackReadNext s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr TrashStack) val' <- (newPtr 8 TrashStack) val return val' -- Flags TraverseFlags data TraverseFlags = TraverseFlagsLeaves | TraverseFlagsNonLeaves | TraverseFlagsAll | TraverseFlagsMask | TraverseFlagsLeafs | TraverseFlagsNonLeafs | AnotherTraverseFlags Int deriving (Show, Eq) instance Enum TraverseFlags where fromEnum TraverseFlagsLeaves = 1 fromEnum TraverseFlagsNonLeaves = 2 fromEnum TraverseFlagsAll = 3 fromEnum TraverseFlagsMask = 3 fromEnum TraverseFlagsLeafs = 1 fromEnum TraverseFlagsNonLeafs = 2 fromEnum (AnotherTraverseFlags k) = k toEnum 1 = TraverseFlagsLeaves toEnum 2 = TraverseFlagsNonLeaves toEnum 3 = TraverseFlagsAll toEnum k = AnotherTraverseFlags k instance IsGFlag TraverseFlags -- callback TraverseFunc traverseFuncClosure :: TraverseFunc -> IO Closure traverseFuncClosure cb = newCClosure =<< mkTraverseFunc wrapped where wrapped = traverseFuncWrapper Nothing cb type TraverseFuncC = Ptr () -> Ptr () -> Ptr () -> IO CInt foreign import ccall "wrapper" mkTraverseFunc :: TraverseFuncC -> IO (FunPtr TraverseFuncC) type TraverseFunc = Ptr () -> Ptr () -> Ptr () -> IO Bool noTraverseFunc :: Maybe TraverseFunc noTraverseFunc = Nothing traverseFuncWrapper :: Maybe (Ptr (FunPtr (TraverseFuncC))) -> TraverseFunc -> Ptr () -> Ptr () -> Ptr () -> IO CInt traverseFuncWrapper funptrptr _cb key value data_ = do result <- _cb key value data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Enum TraverseType data TraverseType = TraverseTypeInOrder | TraverseTypePreOrder | TraverseTypePostOrder | TraverseTypeLevelOrder | AnotherTraverseType Int deriving (Show, Eq) instance Enum TraverseType where fromEnum TraverseTypeInOrder = 0 fromEnum TraverseTypePreOrder = 1 fromEnum TraverseTypePostOrder = 2 fromEnum TraverseTypeLevelOrder = 3 fromEnum (AnotherTraverseType k) = k toEnum 0 = TraverseTypeInOrder toEnum 1 = TraverseTypePreOrder toEnum 2 = TraverseTypePostOrder toEnum 3 = TraverseTypeLevelOrder toEnum k = AnotherTraverseType k -- struct Tree newtype Tree = Tree (ForeignPtr Tree) noTree :: Maybe Tree noTree = Nothing -- method Tree::destroy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tree_destroy" g_tree_destroy :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" IO () treeDestroy :: (MonadIO m) => Tree -> -- _obj m () treeDestroy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_tree_destroy _obj' touchManagedPtr _obj return () -- method Tree::height -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_tree_height" g_tree_height :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" IO Int32 treeHeight :: (MonadIO m) => Tree -> -- _obj m Int32 treeHeight _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_tree_height _obj' touchManagedPtr _obj return result -- method Tree::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tree_insert" g_tree_insert :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" Ptr () -> -- key : TBasicType TVoid Ptr () -> -- value : TBasicType TVoid IO () treeInsert :: (MonadIO m) => Tree -> -- _obj Ptr () -> -- key Ptr () -> -- value m () treeInsert _obj key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_tree_insert _obj' key value touchManagedPtr _obj return () -- method Tree::lookup_extended -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "orig_key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "orig_key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tree_lookup_extended" g_tree_lookup_extended :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" Ptr () -> -- lookup_key : TBasicType TVoid Ptr () -> -- orig_key : TBasicType TVoid Ptr () -> -- value : TBasicType TVoid IO CInt treeLookupExtended :: (MonadIO m) => Tree -> -- _obj Ptr () -> -- lookup_key Ptr () -> -- orig_key Ptr () -> -- value m Bool treeLookupExtended _obj lookup_key orig_key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_tree_lookup_extended _obj' lookup_key orig_key value let result' = (/= 0) result touchManagedPtr _obj return result' -- method Tree::nnodes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_tree_nnodes" g_tree_nnodes :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" IO Int32 treeNnodes :: (MonadIO m) => Tree -> -- _obj m Int32 treeNnodes _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_tree_nnodes _obj' touchManagedPtr _obj return result -- method Tree::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tree_remove" g_tree_remove :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" Ptr () -> -- key : TBasicType TVoid IO CInt treeRemove :: (MonadIO m) => Tree -> -- _obj Ptr () -> -- key m Bool treeRemove _obj key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_tree_remove _obj' key let result' = (/= 0) result touchManagedPtr _obj return result' -- method Tree::replace -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tree_replace" g_tree_replace :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" Ptr () -> -- key : TBasicType TVoid Ptr () -> -- value : TBasicType TVoid IO () treeReplace :: (MonadIO m) => Tree -> -- _obj Ptr () -> -- key Ptr () -> -- value m () treeReplace _obj key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_tree_replace _obj' key value touchManagedPtr _obj return () -- method Tree::steal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tree_steal" g_tree_steal :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" Ptr () -> -- key : TBasicType TVoid IO CInt treeSteal :: (MonadIO m) => Tree -> -- _obj Ptr () -> -- key m Bool treeSteal _obj key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_tree_steal _obj' key let result' = (/= 0) result touchManagedPtr _obj return result' -- method Tree::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "Tree", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tree_unref" g_tree_unref :: Ptr Tree -> -- _obj : TInterface "GLib" "Tree" IO () treeUnref :: (MonadIO m) => Tree -> -- _obj m () treeUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_tree_unref _obj' touchManagedPtr _obj return () -- Enum UnicodeBreakType data UnicodeBreakType = UnicodeBreakTypeMandatory | UnicodeBreakTypeCarriageReturn | UnicodeBreakTypeLineFeed | UnicodeBreakTypeCombiningMark | UnicodeBreakTypeSurrogate | UnicodeBreakTypeZeroWidthSpace | UnicodeBreakTypeInseparable | UnicodeBreakTypeNonBreakingGlue | UnicodeBreakTypeContingent | UnicodeBreakTypeSpace | UnicodeBreakTypeAfter | UnicodeBreakTypeBefore | UnicodeBreakTypeBeforeAndAfter | UnicodeBreakTypeHyphen | UnicodeBreakTypeNonStarter | UnicodeBreakTypeOpenPunctuation | UnicodeBreakTypeClosePunctuation | UnicodeBreakTypeQuotation | UnicodeBreakTypeExclamation | UnicodeBreakTypeIdeographic | UnicodeBreakTypeNumeric | UnicodeBreakTypeInfixSeparator | UnicodeBreakTypeSymbol | UnicodeBreakTypeAlphabetic | UnicodeBreakTypePrefix | UnicodeBreakTypePostfix | UnicodeBreakTypeComplexContext | UnicodeBreakTypeAmbiguous | UnicodeBreakTypeUnknown | UnicodeBreakTypeNextLine | UnicodeBreakTypeWordJoiner | UnicodeBreakTypeHangulLJamo | UnicodeBreakTypeHangulVJamo | UnicodeBreakTypeHangulTJamo | UnicodeBreakTypeHangulLvSyllable | UnicodeBreakTypeHangulLvtSyllable | UnicodeBreakTypeCloseParanthesis | UnicodeBreakTypeConditionalJapaneseStarter | UnicodeBreakTypeHebrewLetter | UnicodeBreakTypeRegionalIndicator | AnotherUnicodeBreakType Int deriving (Show, Eq) instance Enum UnicodeBreakType where fromEnum UnicodeBreakTypeMandatory = 0 fromEnum UnicodeBreakTypeCarriageReturn = 1 fromEnum UnicodeBreakTypeLineFeed = 2 fromEnum UnicodeBreakTypeCombiningMark = 3 fromEnum UnicodeBreakTypeSurrogate = 4 fromEnum UnicodeBreakTypeZeroWidthSpace = 5 fromEnum UnicodeBreakTypeInseparable = 6 fromEnum UnicodeBreakTypeNonBreakingGlue = 7 fromEnum UnicodeBreakTypeContingent = 8 fromEnum UnicodeBreakTypeSpace = 9 fromEnum UnicodeBreakTypeAfter = 10 fromEnum UnicodeBreakTypeBefore = 11 fromEnum UnicodeBreakTypeBeforeAndAfter = 12 fromEnum UnicodeBreakTypeHyphen = 13 fromEnum UnicodeBreakTypeNonStarter = 14 fromEnum UnicodeBreakTypeOpenPunctuation = 15 fromEnum UnicodeBreakTypeClosePunctuation = 16 fromEnum UnicodeBreakTypeQuotation = 17 fromEnum UnicodeBreakTypeExclamation = 18 fromEnum UnicodeBreakTypeIdeographic = 19 fromEnum UnicodeBreakTypeNumeric = 20 fromEnum UnicodeBreakTypeInfixSeparator = 21 fromEnum UnicodeBreakTypeSymbol = 22 fromEnum UnicodeBreakTypeAlphabetic = 23 fromEnum UnicodeBreakTypePrefix = 24 fromEnum UnicodeBreakTypePostfix = 25 fromEnum UnicodeBreakTypeComplexContext = 26 fromEnum UnicodeBreakTypeAmbiguous = 27 fromEnum UnicodeBreakTypeUnknown = 28 fromEnum UnicodeBreakTypeNextLine = 29 fromEnum UnicodeBreakTypeWordJoiner = 30 fromEnum UnicodeBreakTypeHangulLJamo = 31 fromEnum UnicodeBreakTypeHangulVJamo = 32 fromEnum UnicodeBreakTypeHangulTJamo = 33 fromEnum UnicodeBreakTypeHangulLvSyllable = 34 fromEnum UnicodeBreakTypeHangulLvtSyllable = 35 fromEnum UnicodeBreakTypeCloseParanthesis = 36 fromEnum UnicodeBreakTypeConditionalJapaneseStarter = 37 fromEnum UnicodeBreakTypeHebrewLetter = 38 fromEnum UnicodeBreakTypeRegionalIndicator = 39 fromEnum (AnotherUnicodeBreakType k) = k toEnum 0 = UnicodeBreakTypeMandatory toEnum 1 = UnicodeBreakTypeCarriageReturn toEnum 2 = UnicodeBreakTypeLineFeed toEnum 3 = UnicodeBreakTypeCombiningMark toEnum 4 = UnicodeBreakTypeSurrogate toEnum 5 = UnicodeBreakTypeZeroWidthSpace toEnum 6 = UnicodeBreakTypeInseparable toEnum 7 = UnicodeBreakTypeNonBreakingGlue toEnum 8 = UnicodeBreakTypeContingent toEnum 9 = UnicodeBreakTypeSpace toEnum 10 = UnicodeBreakTypeAfter toEnum 11 = UnicodeBreakTypeBefore toEnum 12 = UnicodeBreakTypeBeforeAndAfter toEnum 13 = UnicodeBreakTypeHyphen toEnum 14 = UnicodeBreakTypeNonStarter toEnum 15 = UnicodeBreakTypeOpenPunctuation toEnum 16 = UnicodeBreakTypeClosePunctuation toEnum 17 = UnicodeBreakTypeQuotation toEnum 18 = UnicodeBreakTypeExclamation toEnum 19 = UnicodeBreakTypeIdeographic toEnum 20 = UnicodeBreakTypeNumeric toEnum 21 = UnicodeBreakTypeInfixSeparator toEnum 22 = UnicodeBreakTypeSymbol toEnum 23 = UnicodeBreakTypeAlphabetic toEnum 24 = UnicodeBreakTypePrefix toEnum 25 = UnicodeBreakTypePostfix toEnum 26 = UnicodeBreakTypeComplexContext toEnum 27 = UnicodeBreakTypeAmbiguous toEnum 28 = UnicodeBreakTypeUnknown toEnum 29 = UnicodeBreakTypeNextLine toEnum 30 = UnicodeBreakTypeWordJoiner toEnum 31 = UnicodeBreakTypeHangulLJamo toEnum 32 = UnicodeBreakTypeHangulVJamo toEnum 33 = UnicodeBreakTypeHangulTJamo toEnum 34 = UnicodeBreakTypeHangulLvSyllable toEnum 35 = UnicodeBreakTypeHangulLvtSyllable toEnum 36 = UnicodeBreakTypeCloseParanthesis toEnum 37 = UnicodeBreakTypeConditionalJapaneseStarter toEnum 38 = UnicodeBreakTypeHebrewLetter toEnum 39 = UnicodeBreakTypeRegionalIndicator toEnum k = AnotherUnicodeBreakType k -- Enum UnicodeScript data UnicodeScript = UnicodeScriptInvalidCode | UnicodeScriptCommon | UnicodeScriptInherited | UnicodeScriptArabic | UnicodeScriptArmenian | UnicodeScriptBengali | UnicodeScriptBopomofo | UnicodeScriptCherokee | UnicodeScriptCoptic | UnicodeScriptCyrillic | UnicodeScriptDeseret | UnicodeScriptDevanagari | UnicodeScriptEthiopic | UnicodeScriptGeorgian | UnicodeScriptGothic | UnicodeScriptGreek | UnicodeScriptGujarati | UnicodeScriptGurmukhi | UnicodeScriptHan | UnicodeScriptHangul | UnicodeScriptHebrew | UnicodeScriptHiragana | UnicodeScriptKannada | UnicodeScriptKatakana | UnicodeScriptKhmer | UnicodeScriptLao | UnicodeScriptLatin | UnicodeScriptMalayalam | UnicodeScriptMongolian | UnicodeScriptMyanmar | UnicodeScriptOgham | UnicodeScriptOldItalic | UnicodeScriptOriya | UnicodeScriptRunic | UnicodeScriptSinhala | UnicodeScriptSyriac | UnicodeScriptTamil | UnicodeScriptTelugu | UnicodeScriptThaana | UnicodeScriptThai | UnicodeScriptTibetan | UnicodeScriptCanadianAboriginal | UnicodeScriptYi | UnicodeScriptTagalog | UnicodeScriptHanunoo | UnicodeScriptBuhid | UnicodeScriptTagbanwa | UnicodeScriptBraille | UnicodeScriptCypriot | UnicodeScriptLimbu | UnicodeScriptOsmanya | UnicodeScriptShavian | UnicodeScriptLinearB | UnicodeScriptTaiLe | UnicodeScriptUgaritic | UnicodeScriptNewTaiLue | UnicodeScriptBuginese | UnicodeScriptGlagolitic | UnicodeScriptTifinagh | UnicodeScriptSylotiNagri | UnicodeScriptOldPersian | UnicodeScriptKharoshthi | UnicodeScriptUnknown | UnicodeScriptBalinese | UnicodeScriptCuneiform | UnicodeScriptPhoenician | UnicodeScriptPhagsPa | UnicodeScriptNko | UnicodeScriptKayahLi | UnicodeScriptLepcha | UnicodeScriptRejang | UnicodeScriptSundanese | UnicodeScriptSaurashtra | UnicodeScriptCham | UnicodeScriptOlChiki | UnicodeScriptVai | UnicodeScriptCarian | UnicodeScriptLycian | UnicodeScriptLydian | UnicodeScriptAvestan | UnicodeScriptBamum | UnicodeScriptEgyptianHieroglyphs | UnicodeScriptImperialAramaic | UnicodeScriptInscriptionalPahlavi | UnicodeScriptInscriptionalParthian | UnicodeScriptJavanese | UnicodeScriptKaithi | UnicodeScriptLisu | UnicodeScriptMeeteiMayek | UnicodeScriptOldSouthArabian | UnicodeScriptOldTurkic | UnicodeScriptSamaritan | UnicodeScriptTaiTham | UnicodeScriptTaiViet | UnicodeScriptBatak | UnicodeScriptBrahmi | UnicodeScriptMandaic | UnicodeScriptChakma | UnicodeScriptMeroiticCursive | UnicodeScriptMeroiticHieroglyphs | UnicodeScriptMiao | UnicodeScriptSharada | UnicodeScriptSoraSompeng | UnicodeScriptTakri | UnicodeScriptBassaVah | UnicodeScriptCaucasianAlbanian | UnicodeScriptDuployan | UnicodeScriptElbasan | UnicodeScriptGrantha | UnicodeScriptKhojki | UnicodeScriptKhudawadi | UnicodeScriptLinearA | UnicodeScriptMahajani | UnicodeScriptManichaean | UnicodeScriptMendeKikakui | UnicodeScriptModi | UnicodeScriptMro | UnicodeScriptNabataean | UnicodeScriptOldNorthArabian | UnicodeScriptOldPermic | UnicodeScriptPahawhHmong | UnicodeScriptPalmyrene | UnicodeScriptPauCinHau | UnicodeScriptPsalterPahlavi | UnicodeScriptSiddham | UnicodeScriptTirhuta | UnicodeScriptWarangCiti | AnotherUnicodeScript Int deriving (Show, Eq) instance Enum UnicodeScript where fromEnum UnicodeScriptInvalidCode = -1 fromEnum UnicodeScriptCommon = 0 fromEnum UnicodeScriptInherited = 1 fromEnum UnicodeScriptArabic = 2 fromEnum UnicodeScriptArmenian = 3 fromEnum UnicodeScriptBengali = 4 fromEnum UnicodeScriptBopomofo = 5 fromEnum UnicodeScriptCherokee = 6 fromEnum UnicodeScriptCoptic = 7 fromEnum UnicodeScriptCyrillic = 8 fromEnum UnicodeScriptDeseret = 9 fromEnum UnicodeScriptDevanagari = 10 fromEnum UnicodeScriptEthiopic = 11 fromEnum UnicodeScriptGeorgian = 12 fromEnum UnicodeScriptGothic = 13 fromEnum UnicodeScriptGreek = 14 fromEnum UnicodeScriptGujarati = 15 fromEnum UnicodeScriptGurmukhi = 16 fromEnum UnicodeScriptHan = 17 fromEnum UnicodeScriptHangul = 18 fromEnum UnicodeScriptHebrew = 19 fromEnum UnicodeScriptHiragana = 20 fromEnum UnicodeScriptKannada = 21 fromEnum UnicodeScriptKatakana = 22 fromEnum UnicodeScriptKhmer = 23 fromEnum UnicodeScriptLao = 24 fromEnum UnicodeScriptLatin = 25 fromEnum UnicodeScriptMalayalam = 26 fromEnum UnicodeScriptMongolian = 27 fromEnum UnicodeScriptMyanmar = 28 fromEnum UnicodeScriptOgham = 29 fromEnum UnicodeScriptOldItalic = 30 fromEnum UnicodeScriptOriya = 31 fromEnum UnicodeScriptRunic = 32 fromEnum UnicodeScriptSinhala = 33 fromEnum UnicodeScriptSyriac = 34 fromEnum UnicodeScriptTamil = 35 fromEnum UnicodeScriptTelugu = 36 fromEnum UnicodeScriptThaana = 37 fromEnum UnicodeScriptThai = 38 fromEnum UnicodeScriptTibetan = 39 fromEnum UnicodeScriptCanadianAboriginal = 40 fromEnum UnicodeScriptYi = 41 fromEnum UnicodeScriptTagalog = 42 fromEnum UnicodeScriptHanunoo = 43 fromEnum UnicodeScriptBuhid = 44 fromEnum UnicodeScriptTagbanwa = 45 fromEnum UnicodeScriptBraille = 46 fromEnum UnicodeScriptCypriot = 47 fromEnum UnicodeScriptLimbu = 48 fromEnum UnicodeScriptOsmanya = 49 fromEnum UnicodeScriptShavian = 50 fromEnum UnicodeScriptLinearB = 51 fromEnum UnicodeScriptTaiLe = 52 fromEnum UnicodeScriptUgaritic = 53 fromEnum UnicodeScriptNewTaiLue = 54 fromEnum UnicodeScriptBuginese = 55 fromEnum UnicodeScriptGlagolitic = 56 fromEnum UnicodeScriptTifinagh = 57 fromEnum UnicodeScriptSylotiNagri = 58 fromEnum UnicodeScriptOldPersian = 59 fromEnum UnicodeScriptKharoshthi = 60 fromEnum UnicodeScriptUnknown = 61 fromEnum UnicodeScriptBalinese = 62 fromEnum UnicodeScriptCuneiform = 63 fromEnum UnicodeScriptPhoenician = 64 fromEnum UnicodeScriptPhagsPa = 65 fromEnum UnicodeScriptNko = 66 fromEnum UnicodeScriptKayahLi = 67 fromEnum UnicodeScriptLepcha = 68 fromEnum UnicodeScriptRejang = 69 fromEnum UnicodeScriptSundanese = 70 fromEnum UnicodeScriptSaurashtra = 71 fromEnum UnicodeScriptCham = 72 fromEnum UnicodeScriptOlChiki = 73 fromEnum UnicodeScriptVai = 74 fromEnum UnicodeScriptCarian = 75 fromEnum UnicodeScriptLycian = 76 fromEnum UnicodeScriptLydian = 77 fromEnum UnicodeScriptAvestan = 78 fromEnum UnicodeScriptBamum = 79 fromEnum UnicodeScriptEgyptianHieroglyphs = 80 fromEnum UnicodeScriptImperialAramaic = 81 fromEnum UnicodeScriptInscriptionalPahlavi = 82 fromEnum UnicodeScriptInscriptionalParthian = 83 fromEnum UnicodeScriptJavanese = 84 fromEnum UnicodeScriptKaithi = 85 fromEnum UnicodeScriptLisu = 86 fromEnum UnicodeScriptMeeteiMayek = 87 fromEnum UnicodeScriptOldSouthArabian = 88 fromEnum UnicodeScriptOldTurkic = 89 fromEnum UnicodeScriptSamaritan = 90 fromEnum UnicodeScriptTaiTham = 91 fromEnum UnicodeScriptTaiViet = 92 fromEnum UnicodeScriptBatak = 93 fromEnum UnicodeScriptBrahmi = 94 fromEnum UnicodeScriptMandaic = 95 fromEnum UnicodeScriptChakma = 96 fromEnum UnicodeScriptMeroiticCursive = 97 fromEnum UnicodeScriptMeroiticHieroglyphs = 98 fromEnum UnicodeScriptMiao = 99 fromEnum UnicodeScriptSharada = 100 fromEnum UnicodeScriptSoraSompeng = 101 fromEnum UnicodeScriptTakri = 102 fromEnum UnicodeScriptBassaVah = 103 fromEnum UnicodeScriptCaucasianAlbanian = 104 fromEnum UnicodeScriptDuployan = 105 fromEnum UnicodeScriptElbasan = 106 fromEnum UnicodeScriptGrantha = 107 fromEnum UnicodeScriptKhojki = 108 fromEnum UnicodeScriptKhudawadi = 109 fromEnum UnicodeScriptLinearA = 110 fromEnum UnicodeScriptMahajani = 111 fromEnum UnicodeScriptManichaean = 112 fromEnum UnicodeScriptMendeKikakui = 113 fromEnum UnicodeScriptModi = 114 fromEnum UnicodeScriptMro = 115 fromEnum UnicodeScriptNabataean = 116 fromEnum UnicodeScriptOldNorthArabian = 117 fromEnum UnicodeScriptOldPermic = 118 fromEnum UnicodeScriptPahawhHmong = 119 fromEnum UnicodeScriptPalmyrene = 120 fromEnum UnicodeScriptPauCinHau = 121 fromEnum UnicodeScriptPsalterPahlavi = 122 fromEnum UnicodeScriptSiddham = 123 fromEnum UnicodeScriptTirhuta = 124 fromEnum UnicodeScriptWarangCiti = 125 fromEnum (AnotherUnicodeScript k) = k toEnum -1 = UnicodeScriptInvalidCode toEnum 0 = UnicodeScriptCommon toEnum 1 = UnicodeScriptInherited toEnum 2 = UnicodeScriptArabic toEnum 3 = UnicodeScriptArmenian toEnum 4 = UnicodeScriptBengali toEnum 5 = UnicodeScriptBopomofo toEnum 6 = UnicodeScriptCherokee toEnum 7 = UnicodeScriptCoptic toEnum 8 = UnicodeScriptCyrillic toEnum 9 = UnicodeScriptDeseret toEnum 10 = UnicodeScriptDevanagari toEnum 11 = UnicodeScriptEthiopic toEnum 12 = UnicodeScriptGeorgian toEnum 13 = UnicodeScriptGothic toEnum 14 = UnicodeScriptGreek toEnum 15 = UnicodeScriptGujarati toEnum 16 = UnicodeScriptGurmukhi toEnum 17 = UnicodeScriptHan toEnum 18 = UnicodeScriptHangul toEnum 19 = UnicodeScriptHebrew toEnum 20 = UnicodeScriptHiragana toEnum 21 = UnicodeScriptKannada toEnum 22 = UnicodeScriptKatakana toEnum 23 = UnicodeScriptKhmer toEnum 24 = UnicodeScriptLao toEnum 25 = UnicodeScriptLatin toEnum 26 = UnicodeScriptMalayalam toEnum 27 = UnicodeScriptMongolian toEnum 28 = UnicodeScriptMyanmar toEnum 29 = UnicodeScriptOgham toEnum 30 = UnicodeScriptOldItalic toEnum 31 = UnicodeScriptOriya toEnum 32 = UnicodeScriptRunic toEnum 33 = UnicodeScriptSinhala toEnum 34 = UnicodeScriptSyriac toEnum 35 = UnicodeScriptTamil toEnum 36 = UnicodeScriptTelugu toEnum 37 = UnicodeScriptThaana toEnum 38 = UnicodeScriptThai toEnum 39 = UnicodeScriptTibetan toEnum 40 = UnicodeScriptCanadianAboriginal toEnum 41 = UnicodeScriptYi toEnum 42 = UnicodeScriptTagalog toEnum 43 = UnicodeScriptHanunoo toEnum 44 = UnicodeScriptBuhid toEnum 45 = UnicodeScriptTagbanwa toEnum 46 = UnicodeScriptBraille toEnum 47 = UnicodeScriptCypriot toEnum 48 = UnicodeScriptLimbu toEnum 49 = UnicodeScriptOsmanya toEnum 50 = UnicodeScriptShavian toEnum 51 = UnicodeScriptLinearB toEnum 52 = UnicodeScriptTaiLe toEnum 53 = UnicodeScriptUgaritic toEnum 54 = UnicodeScriptNewTaiLue toEnum 55 = UnicodeScriptBuginese toEnum 56 = UnicodeScriptGlagolitic toEnum 57 = UnicodeScriptTifinagh toEnum 58 = UnicodeScriptSylotiNagri toEnum 59 = UnicodeScriptOldPersian toEnum 60 = UnicodeScriptKharoshthi toEnum 61 = UnicodeScriptUnknown toEnum 62 = UnicodeScriptBalinese toEnum 63 = UnicodeScriptCuneiform toEnum 64 = UnicodeScriptPhoenician toEnum 65 = UnicodeScriptPhagsPa toEnum 66 = UnicodeScriptNko toEnum 67 = UnicodeScriptKayahLi toEnum 68 = UnicodeScriptLepcha toEnum 69 = UnicodeScriptRejang toEnum 70 = UnicodeScriptSundanese toEnum 71 = UnicodeScriptSaurashtra toEnum 72 = UnicodeScriptCham toEnum 73 = UnicodeScriptOlChiki toEnum 74 = UnicodeScriptVai toEnum 75 = UnicodeScriptCarian toEnum 76 = UnicodeScriptLycian toEnum 77 = UnicodeScriptLydian toEnum 78 = UnicodeScriptAvestan toEnum 79 = UnicodeScriptBamum toEnum 80 = UnicodeScriptEgyptianHieroglyphs toEnum 81 = UnicodeScriptImperialAramaic toEnum 82 = UnicodeScriptInscriptionalPahlavi toEnum 83 = UnicodeScriptInscriptionalParthian toEnum 84 = UnicodeScriptJavanese toEnum 85 = UnicodeScriptKaithi toEnum 86 = UnicodeScriptLisu toEnum 87 = UnicodeScriptMeeteiMayek toEnum 88 = UnicodeScriptOldSouthArabian toEnum 89 = UnicodeScriptOldTurkic toEnum 90 = UnicodeScriptSamaritan toEnum 91 = UnicodeScriptTaiTham toEnum 92 = UnicodeScriptTaiViet toEnum 93 = UnicodeScriptBatak toEnum 94 = UnicodeScriptBrahmi toEnum 95 = UnicodeScriptMandaic toEnum 96 = UnicodeScriptChakma toEnum 97 = UnicodeScriptMeroiticCursive toEnum 98 = UnicodeScriptMeroiticHieroglyphs toEnum 99 = UnicodeScriptMiao toEnum 100 = UnicodeScriptSharada toEnum 101 = UnicodeScriptSoraSompeng toEnum 102 = UnicodeScriptTakri toEnum 103 = UnicodeScriptBassaVah toEnum 104 = UnicodeScriptCaucasianAlbanian toEnum 105 = UnicodeScriptDuployan toEnum 106 = UnicodeScriptElbasan toEnum 107 = UnicodeScriptGrantha toEnum 108 = UnicodeScriptKhojki toEnum 109 = UnicodeScriptKhudawadi toEnum 110 = UnicodeScriptLinearA toEnum 111 = UnicodeScriptMahajani toEnum 112 = UnicodeScriptManichaean toEnum 113 = UnicodeScriptMendeKikakui toEnum 114 = UnicodeScriptModi toEnum 115 = UnicodeScriptMro toEnum 116 = UnicodeScriptNabataean toEnum 117 = UnicodeScriptOldNorthArabian toEnum 118 = UnicodeScriptOldPermic toEnum 119 = UnicodeScriptPahawhHmong toEnum 120 = UnicodeScriptPalmyrene toEnum 121 = UnicodeScriptPauCinHau toEnum 122 = UnicodeScriptPsalterPahlavi toEnum 123 = UnicodeScriptSiddham toEnum 124 = UnicodeScriptTirhuta toEnum 125 = UnicodeScriptWarangCiti toEnum k = AnotherUnicodeScript k -- Enum UnicodeType data UnicodeType = UnicodeTypeControl | UnicodeTypeFormat | UnicodeTypeUnassigned | UnicodeTypePrivateUse | UnicodeTypeSurrogate | UnicodeTypeLowercaseLetter | UnicodeTypeModifierLetter | UnicodeTypeOtherLetter | UnicodeTypeTitlecaseLetter | UnicodeTypeUppercaseLetter | UnicodeTypeSpacingMark | UnicodeTypeEnclosingMark | UnicodeTypeNonSpacingMark | UnicodeTypeDecimalNumber | UnicodeTypeLetterNumber | UnicodeTypeOtherNumber | UnicodeTypeConnectPunctuation | UnicodeTypeDashPunctuation | UnicodeTypeClosePunctuation | UnicodeTypeFinalPunctuation | UnicodeTypeInitialPunctuation | UnicodeTypeOtherPunctuation | UnicodeTypeOpenPunctuation | UnicodeTypeCurrencySymbol | UnicodeTypeModifierSymbol | UnicodeTypeMathSymbol | UnicodeTypeOtherSymbol | UnicodeTypeLineSeparator | UnicodeTypeParagraphSeparator | UnicodeTypeSpaceSeparator | AnotherUnicodeType Int deriving (Show, Eq) instance Enum UnicodeType where fromEnum UnicodeTypeControl = 0 fromEnum UnicodeTypeFormat = 1 fromEnum UnicodeTypeUnassigned = 2 fromEnum UnicodeTypePrivateUse = 3 fromEnum UnicodeTypeSurrogate = 4 fromEnum UnicodeTypeLowercaseLetter = 5 fromEnum UnicodeTypeModifierLetter = 6 fromEnum UnicodeTypeOtherLetter = 7 fromEnum UnicodeTypeTitlecaseLetter = 8 fromEnum UnicodeTypeUppercaseLetter = 9 fromEnum UnicodeTypeSpacingMark = 10 fromEnum UnicodeTypeEnclosingMark = 11 fromEnum UnicodeTypeNonSpacingMark = 12 fromEnum UnicodeTypeDecimalNumber = 13 fromEnum UnicodeTypeLetterNumber = 14 fromEnum UnicodeTypeOtherNumber = 15 fromEnum UnicodeTypeConnectPunctuation = 16 fromEnum UnicodeTypeDashPunctuation = 17 fromEnum UnicodeTypeClosePunctuation = 18 fromEnum UnicodeTypeFinalPunctuation = 19 fromEnum UnicodeTypeInitialPunctuation = 20 fromEnum UnicodeTypeOtherPunctuation = 21 fromEnum UnicodeTypeOpenPunctuation = 22 fromEnum UnicodeTypeCurrencySymbol = 23 fromEnum UnicodeTypeModifierSymbol = 24 fromEnum UnicodeTypeMathSymbol = 25 fromEnum UnicodeTypeOtherSymbol = 26 fromEnum UnicodeTypeLineSeparator = 27 fromEnum UnicodeTypeParagraphSeparator = 28 fromEnum UnicodeTypeSpaceSeparator = 29 fromEnum (AnotherUnicodeType k) = k toEnum 0 = UnicodeTypeControl toEnum 1 = UnicodeTypeFormat toEnum 2 = UnicodeTypeUnassigned toEnum 3 = UnicodeTypePrivateUse toEnum 4 = UnicodeTypeSurrogate toEnum 5 = UnicodeTypeLowercaseLetter toEnum 6 = UnicodeTypeModifierLetter toEnum 7 = UnicodeTypeOtherLetter toEnum 8 = UnicodeTypeTitlecaseLetter toEnum 9 = UnicodeTypeUppercaseLetter toEnum 10 = UnicodeTypeSpacingMark toEnum 11 = UnicodeTypeEnclosingMark toEnum 12 = UnicodeTypeNonSpacingMark toEnum 13 = UnicodeTypeDecimalNumber toEnum 14 = UnicodeTypeLetterNumber toEnum 15 = UnicodeTypeOtherNumber toEnum 16 = UnicodeTypeConnectPunctuation toEnum 17 = UnicodeTypeDashPunctuation toEnum 18 = UnicodeTypeClosePunctuation toEnum 19 = UnicodeTypeFinalPunctuation toEnum 20 = UnicodeTypeInitialPunctuation toEnum 21 = UnicodeTypeOtherPunctuation toEnum 22 = UnicodeTypeOpenPunctuation toEnum 23 = UnicodeTypeCurrencySymbol toEnum 24 = UnicodeTypeModifierSymbol toEnum 25 = UnicodeTypeMathSymbol toEnum 26 = UnicodeTypeOtherSymbol toEnum 27 = UnicodeTypeLineSeparator toEnum 28 = UnicodeTypeParagraphSeparator toEnum 29 = UnicodeTypeSpaceSeparator toEnum k = AnotherUnicodeType k -- callback UnixFDSourceFunc unixFDSourceFuncClosure :: UnixFDSourceFunc -> IO Closure unixFDSourceFuncClosure cb = newCClosure =<< mkUnixFDSourceFunc wrapped where wrapped = unixFDSourceFuncWrapper Nothing cb type UnixFDSourceFuncC = Int32 -> CUInt -> Ptr () -> IO CInt foreign import ccall "wrapper" mkUnixFDSourceFunc :: UnixFDSourceFuncC -> IO (FunPtr UnixFDSourceFuncC) type UnixFDSourceFunc = Int32 -> [IOCondition] -> IO Bool noUnixFDSourceFunc :: Maybe UnixFDSourceFunc noUnixFDSourceFunc = Nothing unixFDSourceFuncWrapper :: Maybe (Ptr (FunPtr (UnixFDSourceFuncC))) -> UnixFDSourceFunc -> Int32 -> CUInt -> Ptr () -> IO CInt unixFDSourceFuncWrapper funptrptr _cb fd condition _ = do let condition' = wordToGFlags condition result <- _cb fd condition' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Enum UserDirectory data UserDirectory = UserDirectoryDirectoryDesktop | UserDirectoryDirectoryDocuments | UserDirectoryDirectoryDownload | UserDirectoryDirectoryMusic | UserDirectoryDirectoryPictures | UserDirectoryDirectoryPublicShare | UserDirectoryDirectoryTemplates | UserDirectoryDirectoryVideos | UserDirectoryNDirectories | AnotherUserDirectory Int deriving (Show, Eq) instance Enum UserDirectory where fromEnum UserDirectoryDirectoryDesktop = 0 fromEnum UserDirectoryDirectoryDocuments = 1 fromEnum UserDirectoryDirectoryDownload = 2 fromEnum UserDirectoryDirectoryMusic = 3 fromEnum UserDirectoryDirectoryPictures = 4 fromEnum UserDirectoryDirectoryPublicShare = 5 fromEnum UserDirectoryDirectoryTemplates = 6 fromEnum UserDirectoryDirectoryVideos = 7 fromEnum UserDirectoryNDirectories = 8 fromEnum (AnotherUserDirectory k) = k toEnum 0 = UserDirectoryDirectoryDesktop toEnum 1 = UserDirectoryDirectoryDocuments toEnum 2 = UserDirectoryDirectoryDownload toEnum 3 = UserDirectoryDirectoryMusic toEnum 4 = UserDirectoryDirectoryPictures toEnum 5 = UserDirectoryDirectoryPublicShare toEnum 6 = UserDirectoryDirectoryTemplates toEnum 7 = UserDirectoryDirectoryVideos toEnum 8 = UserDirectoryNDirectories toEnum k = AnotherUserDirectory k -- struct VariantBuilder newtype VariantBuilder = VariantBuilder (ForeignPtr VariantBuilder) noVariantBuilder :: Maybe VariantBuilder noVariantBuilder = Nothing foreign import ccall "g_variant_builder_get_type" c_g_variant_builder_get_type :: IO GType instance BoxedObject VariantBuilder where boxedType _ = c_g_variant_builder_get_type -- method VariantBuilder::new -- method type : Constructor -- Args : [Arg {argName = "type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantBuilder" -- throws : False -- Skip return : False foreign import ccall "g_variant_builder_new" g_variant_builder_new :: Ptr VariantType -> -- type : TInterface "GLib" "VariantType" IO (Ptr VariantBuilder) variantBuilderNew :: (MonadIO m) => VariantType -> -- type m VariantBuilder variantBuilderNew type_ = liftIO $ do let type_' = unsafeManagedPtrGetPtr type_ result <- g_variant_builder_new type_' result' <- (wrapBoxed VariantBuilder) result touchManagedPtr type_ return result' -- method VariantBuilder::add_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_variant_builder_add_value" g_variant_builder_add_value :: Ptr VariantBuilder -> -- _obj : TInterface "GLib" "VariantBuilder" Ptr GVariant -> -- value : TVariant IO () variantBuilderAddValue :: (MonadIO m) => VariantBuilder -> -- _obj GVariant -> -- value m () variantBuilderAddValue _obj value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let value' = unsafeManagedPtrGetPtr value g_variant_builder_add_value _obj' value' touchManagedPtr _obj return () -- method VariantBuilder::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_variant_builder_close" g_variant_builder_close :: Ptr VariantBuilder -> -- _obj : TInterface "GLib" "VariantBuilder" IO () variantBuilderClose :: (MonadIO m) => VariantBuilder -> -- _obj m () variantBuilderClose _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_variant_builder_close _obj' touchManagedPtr _obj return () -- method VariantBuilder::end -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_variant_builder_end" g_variant_builder_end :: Ptr VariantBuilder -> -- _obj : TInterface "GLib" "VariantBuilder" IO (Ptr GVariant) variantBuilderEnd :: (MonadIO m) => VariantBuilder -> -- _obj m GVariant variantBuilderEnd _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_builder_end _obj' result' <- newGVariantFromPtr result touchManagedPtr _obj return result' -- method VariantBuilder::open -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_variant_builder_open" g_variant_builder_open :: Ptr VariantBuilder -> -- _obj : TInterface "GLib" "VariantBuilder" Ptr VariantType -> -- type : TInterface "GLib" "VariantType" IO () variantBuilderOpen :: (MonadIO m) => VariantBuilder -> -- _obj VariantType -> -- type m () variantBuilderOpen _obj type_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let type_' = unsafeManagedPtrGetPtr type_ g_variant_builder_open _obj' type_' touchManagedPtr _obj touchManagedPtr type_ return () -- method VariantBuilder::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantBuilder" -- throws : False -- Skip return : False foreign import ccall "g_variant_builder_ref" g_variant_builder_ref :: Ptr VariantBuilder -> -- _obj : TInterface "GLib" "VariantBuilder" IO (Ptr VariantBuilder) variantBuilderRef :: (MonadIO m) => VariantBuilder -> -- _obj m VariantBuilder variantBuilderRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_builder_ref _obj' result' <- (wrapBoxed VariantBuilder) result touchManagedPtr _obj return result' -- method VariantBuilder::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantBuilder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_variant_builder_unref" g_variant_builder_unref :: Ptr VariantBuilder -> -- _obj : TInterface "GLib" "VariantBuilder" IO () variantBuilderUnref :: (MonadIO m) => VariantBuilder -> -- _obj m () variantBuilderUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_variant_builder_unref _obj' touchManagedPtr _obj return () -- Enum VariantClass data VariantClass = VariantClassBoolean | VariantClassByte | VariantClassInt16 | VariantClassUint16 | VariantClassInt32 | VariantClassUint32 | VariantClassInt64 | VariantClassUint64 | VariantClassHandle | VariantClassDouble | VariantClassString | VariantClassObjectPath | VariantClassSignature | VariantClassVariant | VariantClassMaybe | VariantClassArray | VariantClassTuple | VariantClassDictEntry | AnotherVariantClass Int deriving (Show, Eq) instance Enum VariantClass where fromEnum VariantClassBoolean = 98 fromEnum VariantClassByte = 121 fromEnum VariantClassInt16 = 110 fromEnum VariantClassUint16 = 113 fromEnum VariantClassInt32 = 105 fromEnum VariantClassUint32 = 117 fromEnum VariantClassInt64 = 120 fromEnum VariantClassUint64 = 116 fromEnum VariantClassHandle = 104 fromEnum VariantClassDouble = 100 fromEnum VariantClassString = 115 fromEnum VariantClassObjectPath = 111 fromEnum VariantClassSignature = 103 fromEnum VariantClassVariant = 118 fromEnum VariantClassMaybe = 109 fromEnum VariantClassArray = 97 fromEnum VariantClassTuple = 40 fromEnum VariantClassDictEntry = 123 fromEnum (AnotherVariantClass k) = k toEnum 40 = VariantClassTuple toEnum 97 = VariantClassArray toEnum 98 = VariantClassBoolean toEnum 100 = VariantClassDouble toEnum 103 = VariantClassSignature toEnum 104 = VariantClassHandle toEnum 105 = VariantClassInt32 toEnum 109 = VariantClassMaybe toEnum 110 = VariantClassInt16 toEnum 111 = VariantClassObjectPath toEnum 113 = VariantClassUint16 toEnum 115 = VariantClassString toEnum 116 = VariantClassUint64 toEnum 117 = VariantClassUint32 toEnum 118 = VariantClassVariant toEnum 120 = VariantClassInt64 toEnum 121 = VariantClassByte toEnum 123 = VariantClassDictEntry toEnum k = AnotherVariantClass k -- struct VariantDict newtype VariantDict = VariantDict (ForeignPtr VariantDict) noVariantDict :: Maybe VariantDict noVariantDict = Nothing foreign import ccall "g_variant_dict_get_type" c_g_variant_dict_get_type :: IO GType instance BoxedObject VariantDict where boxedType _ = c_g_variant_dict_get_type -- method VariantDict::new -- method type : Constructor -- Args : [Arg {argName = "from_asv", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "from_asv", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantDict" -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_new" g_variant_dict_new :: Ptr GVariant -> -- from_asv : TVariant IO (Ptr VariantDict) variantDictNew :: (MonadIO m) => Maybe (GVariant) -> -- from_asv m VariantDict variantDictNew from_asv = liftIO $ do maybeFrom_asv <- case from_asv of Nothing -> return nullPtr Just jFrom_asv -> do let jFrom_asv' = unsafeManagedPtrGetPtr jFrom_asv return jFrom_asv' result <- g_variant_dict_new maybeFrom_asv result' <- (wrapBoxed VariantDict) result return result' -- method VariantDict::clear -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_clear" g_variant_dict_clear :: Ptr VariantDict -> -- _obj : TInterface "GLib" "VariantDict" IO () variantDictClear :: (MonadIO m) => VariantDict -> -- _obj m () variantDictClear _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_variant_dict_clear _obj' touchManagedPtr _obj return () -- method VariantDict::contains -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_contains" g_variant_dict_contains :: Ptr VariantDict -> -- _obj : TInterface "GLib" "VariantDict" CString -> -- key : TBasicType TUTF8 IO CInt variantDictContains :: (MonadIO m) => VariantDict -> -- _obj T.Text -> -- key m Bool variantDictContains _obj key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj key' <- textToCString key result <- g_variant_dict_contains _obj' key' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method VariantDict::end -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_end" g_variant_dict_end :: Ptr VariantDict -> -- _obj : TInterface "GLib" "VariantDict" IO (Ptr GVariant) variantDictEnd :: (MonadIO m) => VariantDict -> -- _obj m GVariant variantDictEnd _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_dict_end _obj' result' <- newGVariantFromPtr result touchManagedPtr _obj return result' -- method VariantDict::insert_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_insert_value" g_variant_dict_insert_value :: Ptr VariantDict -> -- _obj : TInterface "GLib" "VariantDict" CString -> -- key : TBasicType TUTF8 Ptr GVariant -> -- value : TVariant IO () variantDictInsertValue :: (MonadIO m) => VariantDict -> -- _obj T.Text -> -- key GVariant -> -- value m () variantDictInsertValue _obj key value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj key' <- textToCString key let value' = unsafeManagedPtrGetPtr value g_variant_dict_insert_value _obj' key' value' touchManagedPtr _obj freeMem key' return () -- method VariantDict::lookup_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expected_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expected_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_lookup_value" g_variant_dict_lookup_value :: Ptr VariantDict -> -- _obj : TInterface "GLib" "VariantDict" CString -> -- key : TBasicType TUTF8 Ptr VariantType -> -- expected_type : TInterface "GLib" "VariantType" IO (Ptr GVariant) variantDictLookupValue :: (MonadIO m) => VariantDict -> -- _obj T.Text -> -- key Maybe (VariantType) -> -- expected_type m GVariant variantDictLookupValue _obj key expected_type = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj key' <- textToCString key maybeExpected_type <- case expected_type of Nothing -> return nullPtr Just jExpected_type -> do let jExpected_type' = unsafeManagedPtrGetPtr jExpected_type return jExpected_type' result <- g_variant_dict_lookup_value _obj' key' maybeExpected_type result' <- wrapGVariantPtr result touchManagedPtr _obj whenJust expected_type touchManagedPtr freeMem key' return result' -- method VariantDict::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantDict" -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_ref" g_variant_dict_ref :: Ptr VariantDict -> -- _obj : TInterface "GLib" "VariantDict" IO (Ptr VariantDict) variantDictRef :: (MonadIO m) => VariantDict -> -- _obj m VariantDict variantDictRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_dict_ref _obj' result' <- (wrapBoxed VariantDict) result touchManagedPtr _obj return result' -- method VariantDict::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_remove" g_variant_dict_remove :: Ptr VariantDict -> -- _obj : TInterface "GLib" "VariantDict" CString -> -- key : TBasicType TUTF8 IO CInt variantDictRemove :: (MonadIO m) => VariantDict -> -- _obj T.Text -> -- key m Bool variantDictRemove _obj key = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj key' <- textToCString key result <- g_variant_dict_remove _obj' key' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method VariantDict::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantDict", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_variant_dict_unref" g_variant_dict_unref :: Ptr VariantDict -> -- _obj : TInterface "GLib" "VariantDict" IO () variantDictUnref :: (MonadIO m) => VariantDict -> -- _obj m () variantDictUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_variant_dict_unref _obj' touchManagedPtr _obj return () -- Enum VariantParseError data VariantParseError = VariantParseErrorFailed | VariantParseErrorBasicTypeExpected | VariantParseErrorCannotInferType | VariantParseErrorDefiniteTypeExpected | VariantParseErrorInputNotAtEnd | VariantParseErrorInvalidCharacter | VariantParseErrorInvalidFormatString | VariantParseErrorInvalidObjectPath | VariantParseErrorInvalidSignature | VariantParseErrorInvalidTypeString | VariantParseErrorNoCommonType | VariantParseErrorNumberOutOfRange | VariantParseErrorNumberTooBig | VariantParseErrorTypeError | VariantParseErrorUnexpectedToken | VariantParseErrorUnknownKeyword | VariantParseErrorUnterminatedStringConstant | VariantParseErrorValueExpected | AnotherVariantParseError Int deriving (Show, Eq) instance Enum VariantParseError where fromEnum VariantParseErrorFailed = 0 fromEnum VariantParseErrorBasicTypeExpected = 1 fromEnum VariantParseErrorCannotInferType = 2 fromEnum VariantParseErrorDefiniteTypeExpected = 3 fromEnum VariantParseErrorInputNotAtEnd = 4 fromEnum VariantParseErrorInvalidCharacter = 5 fromEnum VariantParseErrorInvalidFormatString = 6 fromEnum VariantParseErrorInvalidObjectPath = 7 fromEnum VariantParseErrorInvalidSignature = 8 fromEnum VariantParseErrorInvalidTypeString = 9 fromEnum VariantParseErrorNoCommonType = 10 fromEnum VariantParseErrorNumberOutOfRange = 11 fromEnum VariantParseErrorNumberTooBig = 12 fromEnum VariantParseErrorTypeError = 13 fromEnum VariantParseErrorUnexpectedToken = 14 fromEnum VariantParseErrorUnknownKeyword = 15 fromEnum VariantParseErrorUnterminatedStringConstant = 16 fromEnum VariantParseErrorValueExpected = 17 fromEnum (AnotherVariantParseError k) = k toEnum 0 = VariantParseErrorFailed toEnum 1 = VariantParseErrorBasicTypeExpected toEnum 2 = VariantParseErrorCannotInferType toEnum 3 = VariantParseErrorDefiniteTypeExpected toEnum 4 = VariantParseErrorInputNotAtEnd toEnum 5 = VariantParseErrorInvalidCharacter toEnum 6 = VariantParseErrorInvalidFormatString toEnum 7 = VariantParseErrorInvalidObjectPath toEnum 8 = VariantParseErrorInvalidSignature toEnum 9 = VariantParseErrorInvalidTypeString toEnum 10 = VariantParseErrorNoCommonType toEnum 11 = VariantParseErrorNumberOutOfRange toEnum 12 = VariantParseErrorNumberTooBig toEnum 13 = VariantParseErrorTypeError toEnum 14 = VariantParseErrorUnexpectedToken toEnum 15 = VariantParseErrorUnknownKeyword toEnum 16 = VariantParseErrorUnterminatedStringConstant toEnum 17 = VariantParseErrorValueExpected toEnum k = AnotherVariantParseError k instance GErrorClass VariantParseError where gerrorClassDomain _ = "g-variant-parse-error-quark" catchVariantParseError :: IO a -> (VariantParseError -> GErrorMessage -> IO a) -> IO a catchVariantParseError = catchGErrorJustDomain handleVariantParseError :: (VariantParseError -> GErrorMessage -> IO a) -> IO a -> IO a handleVariantParseError = handleGErrorJustDomain -- struct VariantType newtype VariantType = VariantType (ForeignPtr VariantType) noVariantType :: Maybe VariantType noVariantType = Nothing foreign import ccall "g_variant_type_get_gtype" c_g_variant_type_get_gtype :: IO GType instance BoxedObject VariantType where boxedType _ = c_g_variant_type_get_gtype -- method VariantType::new -- method type : Constructor -- Args : [Arg {argName = "type_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_new" g_variant_type_new :: CString -> -- type_string : TBasicType TUTF8 IO (Ptr VariantType) variantTypeNew :: (MonadIO m) => T.Text -> -- type_string m VariantType variantTypeNew type_string = liftIO $ do type_string' <- textToCString type_string result <- g_variant_type_new type_string' result' <- (wrapBoxed VariantType) result freeMem type_string' return result' -- method VariantType::new_array -- method type : Constructor -- Args : [Arg {argName = "element", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "element", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_new_array" g_variant_type_new_array :: Ptr VariantType -> -- element : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeNewArray :: (MonadIO m) => VariantType -> -- element m VariantType variantTypeNewArray element = liftIO $ do let element' = unsafeManagedPtrGetPtr element result <- g_variant_type_new_array element' result' <- (wrapBoxed VariantType) result touchManagedPtr element return result' -- method VariantType::new_dict_entry -- method type : Constructor -- Args : [Arg {argName = "key", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "key", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_new_dict_entry" g_variant_type_new_dict_entry :: Ptr VariantType -> -- key : TInterface "GLib" "VariantType" Ptr VariantType -> -- value : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeNewDictEntry :: (MonadIO m) => VariantType -> -- key VariantType -> -- value m VariantType variantTypeNewDictEntry key value = liftIO $ do let key' = unsafeManagedPtrGetPtr key let value' = unsafeManagedPtrGetPtr value result <- g_variant_type_new_dict_entry key' value' result' <- (wrapBoxed VariantType) result touchManagedPtr key touchManagedPtr value return result' -- method VariantType::new_maybe -- method type : Constructor -- Args : [Arg {argName = "element", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "element", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_new_maybe" g_variant_type_new_maybe :: Ptr VariantType -> -- element : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeNewMaybe :: (MonadIO m) => VariantType -> -- element m VariantType variantTypeNewMaybe element = liftIO $ do let element' = unsafeManagedPtrGetPtr element result <- g_variant_type_new_maybe element' result' <- (wrapBoxed VariantType) result touchManagedPtr element return result' -- method VariantType::new_tuple -- method type : Constructor -- Args : [Arg {argName = "items", argType = TCArray False (-1) 1 (TInterface "GLib" "VariantType"), 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 : [Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "items", argType = TCArray False (-1) 1 (TInterface "GLib" "VariantType"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_new_tuple" g_variant_type_new_tuple :: Ptr (Ptr VariantType) -> -- items : TCArray False (-1) 1 (TInterface "GLib" "VariantType") Int32 -> -- length : TBasicType TInt32 IO (Ptr VariantType) variantTypeNewTuple :: (MonadIO m) => [VariantType] -> -- items m VariantType variantTypeNewTuple items = liftIO $ do let length_ = fromIntegral $ length items let items' = map unsafeManagedPtrGetPtr items items'' <- packPtrArray items' result <- g_variant_type_new_tuple items'' length_ result' <- (wrapBoxed VariantType) result mapM_ touchManagedPtr items freeMem items'' return result' -- method VariantType::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_copy" g_variant_type_copy :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeCopy :: (MonadIO m) => VariantType -> -- _obj m VariantType variantTypeCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_copy _obj' result' <- (wrapBoxed VariantType) result touchManagedPtr _obj return result' -- method VariantType::dup_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_variant_type_dup_string" g_variant_type_dup_string :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CString variantTypeDupString :: (MonadIO m) => VariantType -> -- _obj m T.Text variantTypeDupString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_dup_string _obj' result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method VariantType::element -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_element" g_variant_type_element :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeElement :: (MonadIO m) => VariantType -> -- _obj m VariantType variantTypeElement _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_element _obj' result' <- (newBoxed VariantType) result touchManagedPtr _obj return result' -- method VariantType::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type2", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type2", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_equal" g_variant_type_equal :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" Ptr VariantType -> -- type2 : TInterface "GLib" "VariantType" IO CInt variantTypeEqual :: (MonadIO m) => VariantType -> -- _obj VariantType -> -- type2 m Bool variantTypeEqual _obj type2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let type2' = unsafeManagedPtrGetPtr type2 result <- g_variant_type_equal _obj' type2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr type2 return result' -- method VariantType::first -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_first" g_variant_type_first :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeFirst :: (MonadIO m) => VariantType -> -- _obj m VariantType variantTypeFirst _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_first _obj' result' <- (newBoxed VariantType) result touchManagedPtr _obj return result' -- method VariantType::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_variant_type_free" g_variant_type_free :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO () variantTypeFree :: (MonadIO m) => VariantType -> -- _obj m () variantTypeFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_variant_type_free _obj' touchManagedPtr _obj return () -- method VariantType::get_string_length -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_variant_type_get_string_length" g_variant_type_get_string_length :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO Word64 variantTypeGetStringLength :: (MonadIO m) => VariantType -> -- _obj m Word64 variantTypeGetStringLength _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_get_string_length _obj' touchManagedPtr _obj return result -- method VariantType::hash -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_variant_type_hash" g_variant_type_hash :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO Word32 variantTypeHash :: (MonadIO m) => VariantType -> -- _obj m Word32 variantTypeHash _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_hash _obj' touchManagedPtr _obj return result -- method VariantType::is_array -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_array" g_variant_type_is_array :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CInt variantTypeIsArray :: (MonadIO m) => VariantType -> -- _obj m Bool variantTypeIsArray _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_is_array _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method VariantType::is_basic -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_basic" g_variant_type_is_basic :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CInt variantTypeIsBasic :: (MonadIO m) => VariantType -> -- _obj m Bool variantTypeIsBasic _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_is_basic _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method VariantType::is_container -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_container" g_variant_type_is_container :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CInt variantTypeIsContainer :: (MonadIO m) => VariantType -> -- _obj m Bool variantTypeIsContainer _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_is_container _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method VariantType::is_definite -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_definite" g_variant_type_is_definite :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CInt variantTypeIsDefinite :: (MonadIO m) => VariantType -> -- _obj m Bool variantTypeIsDefinite _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_is_definite _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method VariantType::is_dict_entry -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_dict_entry" g_variant_type_is_dict_entry :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CInt variantTypeIsDictEntry :: (MonadIO m) => VariantType -> -- _obj m Bool variantTypeIsDictEntry _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_is_dict_entry _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method VariantType::is_maybe -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_maybe" g_variant_type_is_maybe :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CInt variantTypeIsMaybe :: (MonadIO m) => VariantType -> -- _obj m Bool variantTypeIsMaybe _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_is_maybe _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method VariantType::is_subtype_of -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "supertype", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "supertype", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_subtype_of" g_variant_type_is_subtype_of :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" Ptr VariantType -> -- supertype : TInterface "GLib" "VariantType" IO CInt variantTypeIsSubtypeOf :: (MonadIO m) => VariantType -> -- _obj VariantType -> -- supertype m Bool variantTypeIsSubtypeOf _obj supertype = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let supertype' = unsafeManagedPtrGetPtr supertype result <- g_variant_type_is_subtype_of _obj' supertype' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr supertype return result' -- method VariantType::is_tuple -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_tuple" g_variant_type_is_tuple :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CInt variantTypeIsTuple :: (MonadIO m) => VariantType -> -- _obj m Bool variantTypeIsTuple _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_is_tuple _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method VariantType::is_variant -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_is_variant" g_variant_type_is_variant :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO CInt variantTypeIsVariant :: (MonadIO m) => VariantType -> -- _obj m Bool variantTypeIsVariant _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_is_variant _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method VariantType::key -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_key" g_variant_type_key :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeKey :: (MonadIO m) => VariantType -> -- _obj m VariantType variantTypeKey _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_key _obj' result' <- (newBoxed VariantType) result touchManagedPtr _obj return result' -- method VariantType::n_items -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_variant_type_n_items" g_variant_type_n_items :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO Word64 variantTypeNItems :: (MonadIO m) => VariantType -> -- _obj m Word64 variantTypeNItems _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_n_items _obj' touchManagedPtr _obj return result -- method VariantType::next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_next" g_variant_type_next :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeNext :: (MonadIO m) => VariantType -> -- _obj m VariantType variantTypeNext _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_next _obj' result' <- (newBoxed VariantType) result touchManagedPtr _obj return result' -- method VariantType::value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_value" g_variant_type_value :: Ptr VariantType -> -- _obj : TInterface "GLib" "VariantType" IO (Ptr VariantType) variantTypeValue :: (MonadIO m) => VariantType -> -- _obj m VariantType variantTypeValue _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_variant_type_value _obj' result' <- (newBoxed VariantType) result touchManagedPtr _obj return result' -- callback VoidFunc voidFuncClosure :: VoidFunc -> IO Closure voidFuncClosure cb = newCClosure =<< mkVoidFunc wrapped where wrapped = voidFuncWrapper Nothing cb type VoidFuncC = IO () foreign import ccall "wrapper" mkVoidFunc :: VoidFuncC -> IO (FunPtr VoidFuncC) type VoidFunc = IO () noVoidFunc :: Maybe VoidFunc noVoidFunc = Nothing voidFuncWrapper :: Maybe (Ptr (FunPtr (VoidFuncC))) -> VoidFunc -> IO () voidFuncWrapper funptrptr _cb = do _cb maybeReleaseFunPtr funptrptr -- constant _ANALYZER_ANALYZING _ANALYZER_ANALYZING :: Int32 _ANALYZER_ANALYZING = 1 -- constant _ASCII_DTOSTR_BUF_SIZE _ASCII_DTOSTR_BUF_SIZE :: Int32 _ASCII_DTOSTR_BUF_SIZE = 39 -- constant _BIG_ENDIAN _BIG_ENDIAN :: Int32 _BIG_ENDIAN = 4321 -- constant _CAN_INLINE _CAN_INLINE :: Int32 _CAN_INLINE = 1 -- constant _CSET_A_2_Z _CSET_A_2_Z :: T.Text _CSET_A_2_Z = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" -- constant _CSET_DIGITS _CSET_DIGITS :: T.Text _CSET_DIGITS = "0123456789" -- constant _CSET_a_2_z _CSET_a_2_z :: T.Text _CSET_a_2_z = "abcdefghijklmnopqrstuvwxyz" -- constant _DATALIST_FLAGS_MASK _DATALIST_FLAGS_MASK :: Int32 _DATALIST_FLAGS_MASK = 3 -- constant _DATE_BAD_DAY _DATE_BAD_DAY :: Int32 _DATE_BAD_DAY = 0 -- constant _DATE_BAD_JULIAN _DATE_BAD_JULIAN :: Int32 _DATE_BAD_JULIAN = 0 -- constant _DATE_BAD_YEAR _DATE_BAD_YEAR :: Int32 _DATE_BAD_YEAR = 0 -- constant _DIR_SEPARATOR _DIR_SEPARATOR :: Int32 _DIR_SEPARATOR = 92 -- constant _DIR_SEPARATOR_S _DIR_SEPARATOR_S :: T.Text _DIR_SEPARATOR_S = "\\" -- constant _E _E :: Double _E = 2.718282 -- constant _GINT16_FORMAT _GINT16_FORMAT :: T.Text _GINT16_FORMAT = "hi" -- constant _GINT16_MODIFIER _GINT16_MODIFIER :: T.Text _GINT16_MODIFIER = "h" -- constant _GINT32_FORMAT _GINT32_FORMAT :: T.Text _GINT32_FORMAT = "i" -- constant _GINT32_MODIFIER _GINT32_MODIFIER :: T.Text _GINT32_MODIFIER = "" -- constant _GINT64_FORMAT _GINT64_FORMAT :: T.Text _GINT64_FORMAT = "li" -- constant _GINT64_MODIFIER _GINT64_MODIFIER :: T.Text _GINT64_MODIFIER = "l" -- constant _GINTPTR_FORMAT _GINTPTR_FORMAT :: T.Text _GINTPTR_FORMAT = "li" -- constant _GINTPTR_MODIFIER _GINTPTR_MODIFIER :: T.Text _GINTPTR_MODIFIER = "l" -- constant _GNUC_FUNCTION {-# DEPRECATED _GNUC_FUNCTION ["(Since version 2.16)","Use G_STRFUNC() instead"]#-} _GNUC_FUNCTION :: T.Text _GNUC_FUNCTION = "" -- constant _GNUC_PRETTY_FUNCTION {-# DEPRECATED _GNUC_PRETTY_FUNCTION ["(Since version 2.16)","Use G_STRFUNC() instead"]#-} _GNUC_PRETTY_FUNCTION :: T.Text _GNUC_PRETTY_FUNCTION = "" -- constant _GSIZE_FORMAT _GSIZE_FORMAT :: T.Text _GSIZE_FORMAT = "lu" -- constant _GSIZE_MODIFIER _GSIZE_MODIFIER :: T.Text _GSIZE_MODIFIER = "l" -- constant _GSSIZE_FORMAT _GSSIZE_FORMAT :: T.Text _GSSIZE_FORMAT = "li" -- constant _GSSIZE_MODIFIER _GSSIZE_MODIFIER :: T.Text _GSSIZE_MODIFIER = "l" -- constant _GUINT16_FORMAT _GUINT16_FORMAT :: T.Text _GUINT16_FORMAT = "hu" -- constant _GUINT32_FORMAT _GUINT32_FORMAT :: T.Text _GUINT32_FORMAT = "u" -- constant _GUINT64_FORMAT _GUINT64_FORMAT :: T.Text _GUINT64_FORMAT = "lu" -- constant _GUINTPTR_FORMAT _GUINTPTR_FORMAT :: T.Text _GUINTPTR_FORMAT = "lu" -- constant _HAVE_GINT64 _HAVE_GINT64 :: Int32 _HAVE_GINT64 = 1 -- constant _HAVE_GNUC_VARARGS _HAVE_GNUC_VARARGS :: Int32 _HAVE_GNUC_VARARGS = 1 -- constant _HAVE_GNUC_VISIBILITY _HAVE_GNUC_VISIBILITY :: Int32 _HAVE_GNUC_VISIBILITY = 1 -- constant _HAVE_GROWING_STACK _HAVE_GROWING_STACK :: Int32 _HAVE_GROWING_STACK = 0 -- constant _HAVE_INLINE _HAVE_INLINE :: Int32 _HAVE_INLINE = 1 -- constant _HAVE_ISO_VARARGS _HAVE_ISO_VARARGS :: Int32 _HAVE_ISO_VARARGS = 1 -- constant _HAVE___INLINE _HAVE___INLINE :: Int32 _HAVE___INLINE = 1 -- constant _HAVE___INLINE__ _HAVE___INLINE__ :: Int32 _HAVE___INLINE__ = 1 -- constant _HOOK_FLAG_USER_SHIFT _HOOK_FLAG_USER_SHIFT :: Int32 _HOOK_FLAG_USER_SHIFT = 4 -- constant _IEEE754_DOUBLE_BIAS _IEEE754_DOUBLE_BIAS :: Int32 _IEEE754_DOUBLE_BIAS = 1023 -- constant _IEEE754_FLOAT_BIAS _IEEE754_FLOAT_BIAS :: Int32 _IEEE754_FLOAT_BIAS = 127 -- constant _KEY_FILE_DESKTOP_GROUP _KEY_FILE_DESKTOP_GROUP :: T.Text _KEY_FILE_DESKTOP_GROUP = "Desktop Entry" -- constant _KEY_FILE_DESKTOP_KEY_ACTIONS _KEY_FILE_DESKTOP_KEY_ACTIONS :: T.Text _KEY_FILE_DESKTOP_KEY_ACTIONS = "Actions" -- constant _KEY_FILE_DESKTOP_KEY_CATEGORIES _KEY_FILE_DESKTOP_KEY_CATEGORIES :: T.Text _KEY_FILE_DESKTOP_KEY_CATEGORIES = "Categories" -- constant _KEY_FILE_DESKTOP_KEY_COMMENT _KEY_FILE_DESKTOP_KEY_COMMENT :: T.Text _KEY_FILE_DESKTOP_KEY_COMMENT = "Comment" -- constant _KEY_FILE_DESKTOP_KEY_DBUS_ACTIVATABLE _KEY_FILE_DESKTOP_KEY_DBUS_ACTIVATABLE :: T.Text _KEY_FILE_DESKTOP_KEY_DBUS_ACTIVATABLE = "DBusActivatable" -- constant _KEY_FILE_DESKTOP_KEY_EXEC _KEY_FILE_DESKTOP_KEY_EXEC :: T.Text _KEY_FILE_DESKTOP_KEY_EXEC = "Exec" -- constant _KEY_FILE_DESKTOP_KEY_GENERIC_NAME _KEY_FILE_DESKTOP_KEY_GENERIC_NAME :: T.Text _KEY_FILE_DESKTOP_KEY_GENERIC_NAME = "GenericName" -- constant _KEY_FILE_DESKTOP_KEY_HIDDEN _KEY_FILE_DESKTOP_KEY_HIDDEN :: T.Text _KEY_FILE_DESKTOP_KEY_HIDDEN = "Hidden" -- constant _KEY_FILE_DESKTOP_KEY_ICON _KEY_FILE_DESKTOP_KEY_ICON :: T.Text _KEY_FILE_DESKTOP_KEY_ICON = "Icon" -- constant _KEY_FILE_DESKTOP_KEY_MIME_TYPE _KEY_FILE_DESKTOP_KEY_MIME_TYPE :: T.Text _KEY_FILE_DESKTOP_KEY_MIME_TYPE = "MimeType" -- constant _KEY_FILE_DESKTOP_KEY_NAME _KEY_FILE_DESKTOP_KEY_NAME :: T.Text _KEY_FILE_DESKTOP_KEY_NAME = "Name" -- constant _KEY_FILE_DESKTOP_KEY_NOT_SHOW_IN _KEY_FILE_DESKTOP_KEY_NOT_SHOW_IN :: T.Text _KEY_FILE_DESKTOP_KEY_NOT_SHOW_IN = "NotShowIn" -- constant _KEY_FILE_DESKTOP_KEY_NO_DISPLAY _KEY_FILE_DESKTOP_KEY_NO_DISPLAY :: T.Text _KEY_FILE_DESKTOP_KEY_NO_DISPLAY = "NoDisplay" -- constant _KEY_FILE_DESKTOP_KEY_ONLY_SHOW_IN _KEY_FILE_DESKTOP_KEY_ONLY_SHOW_IN :: T.Text _KEY_FILE_DESKTOP_KEY_ONLY_SHOW_IN = "OnlyShowIn" -- constant _KEY_FILE_DESKTOP_KEY_PATH _KEY_FILE_DESKTOP_KEY_PATH :: T.Text _KEY_FILE_DESKTOP_KEY_PATH = "Path" -- constant _KEY_FILE_DESKTOP_KEY_STARTUP_NOTIFY _KEY_FILE_DESKTOP_KEY_STARTUP_NOTIFY :: T.Text _KEY_FILE_DESKTOP_KEY_STARTUP_NOTIFY = "StartupNotify" -- constant _KEY_FILE_DESKTOP_KEY_STARTUP_WM_CLASS _KEY_FILE_DESKTOP_KEY_STARTUP_WM_CLASS :: T.Text _KEY_FILE_DESKTOP_KEY_STARTUP_WM_CLASS = "StartupWMClass" -- constant _KEY_FILE_DESKTOP_KEY_TERMINAL _KEY_FILE_DESKTOP_KEY_TERMINAL :: T.Text _KEY_FILE_DESKTOP_KEY_TERMINAL = "Terminal" -- constant _KEY_FILE_DESKTOP_KEY_TRY_EXEC _KEY_FILE_DESKTOP_KEY_TRY_EXEC :: T.Text _KEY_FILE_DESKTOP_KEY_TRY_EXEC = "TryExec" -- constant _KEY_FILE_DESKTOP_KEY_TYPE _KEY_FILE_DESKTOP_KEY_TYPE :: T.Text _KEY_FILE_DESKTOP_KEY_TYPE = "Type" -- constant _KEY_FILE_DESKTOP_KEY_URL _KEY_FILE_DESKTOP_KEY_URL :: T.Text _KEY_FILE_DESKTOP_KEY_URL = "URL" -- constant _KEY_FILE_DESKTOP_KEY_VERSION _KEY_FILE_DESKTOP_KEY_VERSION :: T.Text _KEY_FILE_DESKTOP_KEY_VERSION = "Version" -- constant _KEY_FILE_DESKTOP_TYPE_APPLICATION _KEY_FILE_DESKTOP_TYPE_APPLICATION :: T.Text _KEY_FILE_DESKTOP_TYPE_APPLICATION = "Application" -- constant _KEY_FILE_DESKTOP_TYPE_DIRECTORY _KEY_FILE_DESKTOP_TYPE_DIRECTORY :: T.Text _KEY_FILE_DESKTOP_TYPE_DIRECTORY = "Directory" -- constant _KEY_FILE_DESKTOP_TYPE_LINK _KEY_FILE_DESKTOP_TYPE_LINK :: T.Text _KEY_FILE_DESKTOP_TYPE_LINK = "Link" -- constant _LITTLE_ENDIAN _LITTLE_ENDIAN :: Int32 _LITTLE_ENDIAN = 1234 -- constant _LN10 _LN10 :: Double _LN10 = 2.302585 -- constant _LN2 _LN2 :: Double _LN2 = 0.693147 -- constant _LOG_2_BASE_10 _LOG_2_BASE_10 :: Double _LOG_2_BASE_10 = 0.301030 -- constant _LOG_DOMAIN _LOG_DOMAIN :: Int8 _LOG_DOMAIN = 0 -- constant _LOG_FATAL_MASK _LOG_FATAL_MASK :: Int32 _LOG_FATAL_MASK = 0 -- constant _LOG_LEVEL_USER_SHIFT _LOG_LEVEL_USER_SHIFT :: Int32 _LOG_LEVEL_USER_SHIFT = 8 -- constant _MAJOR_VERSION _MAJOR_VERSION :: Int32 _MAJOR_VERSION = 2 -- constant _MAXINT16 _MAXINT16 :: Int16 _MAXINT16 = 32767 -- constant _MAXINT32 _MAXINT32 :: Int32 _MAXINT32 = 2147483647 -- constant _MAXINT64 _MAXINT64 :: Int64 _MAXINT64 = 9223372036854775807 -- constant _MAXINT8 _MAXINT8 :: Int8 _MAXINT8 = 127 -- constant _MAXUINT16 _MAXUINT16 :: Word16 _MAXUINT16 = 65535 -- constant _MAXUINT32 _MAXUINT32 :: Word32 _MAXUINT32 = 4294967295 -- constant _MAXUINT64 _MAXUINT64 :: Word64 _MAXUINT64 = 18446744073709551615 -- constant _MAXUINT8 _MAXUINT8 :: Word8 _MAXUINT8 = 255 -- constant _MICRO_VERSION _MICRO_VERSION :: Int32 _MICRO_VERSION = 1 -- constant _MININT16 _MININT16 :: Int16 _MININT16 = 32768 -- constant _MININT32 _MININT32 :: Int32 _MININT32 = 2147483648 -- constant _MININT64 _MININT64 :: Int64 _MININT64 = -9223372036854775808 -- constant _MININT8 _MININT8 :: Int8 _MININT8 = 128 -- constant _MINOR_VERSION _MINOR_VERSION :: Int32 _MINOR_VERSION = 44 -- constant _MODULE_SUFFIX _MODULE_SUFFIX :: T.Text _MODULE_SUFFIX = "so" -- constant _OPTION_REMAINING _OPTION_REMAINING :: T.Text _OPTION_REMAINING = "" -- constant _PDP_ENDIAN _PDP_ENDIAN :: Int32 _PDP_ENDIAN = 3412 -- constant _PI _PI :: Double _PI = 3.141593 -- constant _PI_2 _PI_2 :: Double _PI_2 = 1.570796 -- constant _PI_4 _PI_4 :: Double _PI_4 = 0.785398 -- constant _POLLFD_FORMAT _POLLFD_FORMAT :: T.Text _POLLFD_FORMAT = "%#I64x" -- constant _PRIORITY_DEFAULT _PRIORITY_DEFAULT :: Int32 _PRIORITY_DEFAULT = 0 -- constant _PRIORITY_DEFAULT_IDLE _PRIORITY_DEFAULT_IDLE :: Int32 _PRIORITY_DEFAULT_IDLE = 200 -- constant _PRIORITY_HIGH _PRIORITY_HIGH :: Int32 _PRIORITY_HIGH = -100 -- constant _PRIORITY_HIGH_IDLE _PRIORITY_HIGH_IDLE :: Int32 _PRIORITY_HIGH_IDLE = 100 -- constant _PRIORITY_LOW _PRIORITY_LOW :: Int32 _PRIORITY_LOW = 300 -- constant _SEARCHPATH_SEPARATOR _SEARCHPATH_SEPARATOR :: Int32 _SEARCHPATH_SEPARATOR = 59 -- constant _SEARCHPATH_SEPARATOR_S _SEARCHPATH_SEPARATOR_S :: T.Text _SEARCHPATH_SEPARATOR_S = ";" -- constant _SIZEOF_LONG _SIZEOF_LONG :: Int32 _SIZEOF_LONG = 8 -- constant _SIZEOF_SIZE_T _SIZEOF_SIZE_T :: Int32 _SIZEOF_SIZE_T = 8 -- constant _SIZEOF_SSIZE_T _SIZEOF_SSIZE_T :: Int32 _SIZEOF_SSIZE_T = 8 -- constant _SIZEOF_VOID_P _SIZEOF_VOID_P :: Int32 _SIZEOF_VOID_P = 8 -- constant _SOURCE_CONTINUE _SOURCE_CONTINUE :: Bool _SOURCE_CONTINUE = True -- constant _SOURCE_REMOVE _SOURCE_REMOVE :: Bool _SOURCE_REMOVE = False -- constant _SQRT2 _SQRT2 :: Double _SQRT2 = 1.414214 -- constant _STR_DELIMITERS _STR_DELIMITERS :: T.Text _STR_DELIMITERS = "_-|> <." -- constant _SYSDEF_AF_INET _SYSDEF_AF_INET :: Int32 _SYSDEF_AF_INET = 2 -- constant _SYSDEF_AF_INET6 _SYSDEF_AF_INET6 :: Int32 _SYSDEF_AF_INET6 = 10 -- constant _SYSDEF_AF_UNIX _SYSDEF_AF_UNIX :: Int32 _SYSDEF_AF_UNIX = 1 -- constant _SYSDEF_MSG_DONTROUTE _SYSDEF_MSG_DONTROUTE :: Int32 _SYSDEF_MSG_DONTROUTE = 4 -- constant _SYSDEF_MSG_OOB _SYSDEF_MSG_OOB :: Int32 _SYSDEF_MSG_OOB = 1 -- constant _SYSDEF_MSG_PEEK _SYSDEF_MSG_PEEK :: Int32 _SYSDEF_MSG_PEEK = 2 -- constant _TIME_SPAN_DAY _TIME_SPAN_DAY :: Int64 _TIME_SPAN_DAY = 86400000000 -- constant _TIME_SPAN_HOUR _TIME_SPAN_HOUR :: Int64 _TIME_SPAN_HOUR = 3600000000 -- constant _TIME_SPAN_MILLISECOND _TIME_SPAN_MILLISECOND :: Int64 _TIME_SPAN_MILLISECOND = 1000 -- constant _TIME_SPAN_MINUTE _TIME_SPAN_MINUTE :: Int64 _TIME_SPAN_MINUTE = 60000000 -- constant _TIME_SPAN_SECOND _TIME_SPAN_SECOND :: Int64 _TIME_SPAN_SECOND = 1000000 -- constant _UNICHAR_MAX_DECOMPOSITION_LENGTH _UNICHAR_MAX_DECOMPOSITION_LENGTH :: Int32 _UNICHAR_MAX_DECOMPOSITION_LENGTH = 18 -- constant _URI_RESERVED_CHARS_GENERIC_DELIMITERS _URI_RESERVED_CHARS_GENERIC_DELIMITERS :: T.Text _URI_RESERVED_CHARS_GENERIC_DELIMITERS = ":/?#[]@" -- constant _URI_RESERVED_CHARS_SUBCOMPONENT_DELIMITERS _URI_RESERVED_CHARS_SUBCOMPONENT_DELIMITERS :: T.Text _URI_RESERVED_CHARS_SUBCOMPONENT_DELIMITERS = "!$&'()*+,;=" -- constant _USEC_PER_SEC _USEC_PER_SEC :: Int32 _USEC_PER_SEC = 1000000 -- constant _VA_COPY_AS_ARRAY _VA_COPY_AS_ARRAY :: Int32 _VA_COPY_AS_ARRAY = 1 -- constant _VERSION_MIN_REQUIRED _VERSION_MIN_REQUIRED :: Int32 _VERSION_MIN_REQUIRED = 2 -- constant _WIN32_MSG_HANDLE _WIN32_MSG_HANDLE :: Int32 _WIN32_MSG_HANDLE = 19981206 -- function g_access -- Args : [Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TBasicType TInt32, 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 TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_access" g_access :: CString -> -- filename : TBasicType TUTF8 Int32 -> -- mode : TBasicType TInt32 IO Int32 access :: (MonadIO m) => T.Text -> -- filename Int32 -> -- mode m Int32 access filename mode = liftIO $ do filename' <- textToCString filename result <- g_access filename' mode freeMem filename' return result -- function g_ascii_digit_value -- Args : [Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_ascii_digit_value" g_ascii_digit_value :: Int8 -> -- c : TBasicType TInt8 IO Int32 asciiDigitValue :: (MonadIO m) => Int8 -> -- c m Int32 asciiDigitValue c = liftIO $ do result <- g_ascii_digit_value c return result -- function g_ascii_dtostr -- Args : [Arg {argName = "buffer", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "d", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "buffer", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "d", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_ascii_dtostr" g_ascii_dtostr :: CString -> -- buffer : TBasicType TUTF8 Int32 -> -- buf_len : TBasicType TInt32 CDouble -> -- d : TBasicType TDouble IO CString asciiDtostr :: (MonadIO m) => T.Text -> -- buffer Int32 -> -- buf_len Double -> -- d m T.Text asciiDtostr buffer buf_len d = liftIO $ do buffer' <- textToCString buffer let d' = realToFrac d result <- g_ascii_dtostr buffer' buf_len d' result' <- cstringToText result freeMem result freeMem buffer' return result' -- function g_ascii_formatd -- Args : [Arg {argName = "buffer", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "d", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "buffer", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buf_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "d", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_ascii_formatd" g_ascii_formatd :: CString -> -- buffer : TBasicType TUTF8 Int32 -> -- buf_len : TBasicType TInt32 CString -> -- format : TBasicType TUTF8 CDouble -> -- d : TBasicType TDouble IO CString asciiFormatd :: (MonadIO m) => T.Text -> -- buffer Int32 -> -- buf_len T.Text -> -- format Double -> -- d m T.Text asciiFormatd buffer buf_len format d = liftIO $ do buffer' <- textToCString buffer format' <- textToCString format let d' = realToFrac d result <- g_ascii_formatd buffer' buf_len format' d' result' <- cstringToText result freeMem result freeMem buffer' freeMem format' return result' -- function g_ascii_strcasecmp -- Args : [Arg {argName = "s1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "s2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "s1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "s2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_ascii_strcasecmp" g_ascii_strcasecmp :: CString -> -- s1 : TBasicType TUTF8 CString -> -- s2 : TBasicType TUTF8 IO Int32 asciiStrcasecmp :: (MonadIO m) => T.Text -> -- s1 T.Text -> -- s2 m Int32 asciiStrcasecmp s1 s2 = liftIO $ do s1' <- textToCString s1 s2' <- textToCString s2 result <- g_ascii_strcasecmp s1' s2' freeMem s1' freeMem s2' return result -- function g_ascii_strdown -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_ascii_strdown" g_ascii_strdown :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString asciiStrdown :: (MonadIO m) => T.Text -> -- str Int64 -> -- len m T.Text asciiStrdown str len = liftIO $ do str' <- textToCString str result <- g_ascii_strdown str' len result' <- cstringToText result freeMem result freeMem str' return result' -- function g_ascii_strncasecmp -- Args : [Arg {argName = "s1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "s2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "s1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "s2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_ascii_strncasecmp" g_ascii_strncasecmp :: CString -> -- s1 : TBasicType TUTF8 CString -> -- s2 : TBasicType TUTF8 Word64 -> -- n : TBasicType TUInt64 IO Int32 asciiStrncasecmp :: (MonadIO m) => T.Text -> -- s1 T.Text -> -- s2 Word64 -> -- n m Int32 asciiStrncasecmp s1 s2 n = liftIO $ do s1' <- textToCString s1 s2' <- textToCString s2 result <- g_ascii_strncasecmp s1' s2' n freeMem s1' freeMem s2' return result -- function g_ascii_strtod -- Args : [Arg {argName = "nptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "nptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_ascii_strtod" g_ascii_strtod :: CString -> -- nptr : TBasicType TUTF8 CString -> -- endptr : TBasicType TUTF8 IO CDouble asciiStrtod :: (MonadIO m) => T.Text -> -- nptr T.Text -> -- endptr m Double asciiStrtod nptr endptr = liftIO $ do nptr' <- textToCString nptr endptr' <- textToCString endptr result <- g_ascii_strtod nptr' endptr' let result' = realToFrac result freeMem nptr' freeMem endptr' return result' -- function g_ascii_strtoll -- Args : [Arg {argName = "nptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "nptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_ascii_strtoll" g_ascii_strtoll :: CString -> -- nptr : TBasicType TUTF8 CString -> -- endptr : TBasicType TUTF8 Word32 -> -- base : TBasicType TUInt32 IO Int64 asciiStrtoll :: (MonadIO m) => T.Text -> -- nptr T.Text -> -- endptr Word32 -> -- base m Int64 asciiStrtoll nptr endptr base = liftIO $ do nptr' <- textToCString nptr endptr' <- textToCString endptr result <- g_ascii_strtoll nptr' endptr' base freeMem nptr' freeMem endptr' return result -- function g_ascii_strtoull -- Args : [Arg {argName = "nptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "nptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_ascii_strtoull" g_ascii_strtoull :: CString -> -- nptr : TBasicType TUTF8 CString -> -- endptr : TBasicType TUTF8 Word32 -> -- base : TBasicType TUInt32 IO Word64 asciiStrtoull :: (MonadIO m) => T.Text -> -- nptr T.Text -> -- endptr Word32 -> -- base m Word64 asciiStrtoull nptr endptr base = liftIO $ do nptr' <- textToCString nptr endptr' <- textToCString endptr result <- g_ascii_strtoull nptr' endptr' base freeMem nptr' freeMem endptr' return result -- function g_ascii_strup -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_ascii_strup" g_ascii_strup :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString asciiStrup :: (MonadIO m) => T.Text -> -- str Int64 -> -- len m T.Text asciiStrup str len = liftIO $ do str' <- textToCString str result <- g_ascii_strup str' len result' <- cstringToText result freeMem result freeMem str' return result' -- function g_ascii_tolower -- Args : [Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt8 -- throws : False -- Skip return : False foreign import ccall "g_ascii_tolower" g_ascii_tolower :: Int8 -> -- c : TBasicType TInt8 IO Int8 asciiTolower :: (MonadIO m) => Int8 -> -- c m Int8 asciiTolower c = liftIO $ do result <- g_ascii_tolower c return result -- function g_ascii_toupper -- Args : [Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt8 -- throws : False -- Skip return : False foreign import ccall "g_ascii_toupper" g_ascii_toupper :: Int8 -> -- c : TBasicType TInt8 IO Int8 asciiToupper :: (MonadIO m) => Int8 -> -- c m Int8 asciiToupper c = liftIO $ do result <- g_ascii_toupper c return result -- function g_ascii_xdigit_value -- Args : [Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_ascii_xdigit_value" g_ascii_xdigit_value :: Int8 -> -- c : TBasicType TInt8 IO Int32 asciiXdigitValue :: (MonadIO m) => Int8 -> -- c m Int32 asciiXdigitValue c = liftIO $ do result <- g_ascii_xdigit_value c return result -- function g_assert_warning -- Args : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pretty_function", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expression", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pretty_function", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expression", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_assert_warning" g_assert_warning :: CString -> -- log_domain : TBasicType TUTF8 CString -> -- file : TBasicType TUTF8 Int32 -> -- line : TBasicType TInt32 CString -> -- pretty_function : TBasicType TUTF8 CString -> -- expression : TBasicType TUTF8 IO () assertWarning :: (MonadIO m) => T.Text -> -- log_domain T.Text -> -- file Int32 -> -- line T.Text -> -- pretty_function T.Text -> -- expression m () assertWarning log_domain file line pretty_function expression = liftIO $ do log_domain' <- textToCString log_domain file' <- textToCString file pretty_function' <- textToCString pretty_function expression' <- textToCString expression g_assert_warning log_domain' file' line pretty_function' expression' freeMem log_domain' freeMem file' freeMem pretty_function' freeMem expression' return () -- function g_assertion_message -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_assertion_message" g_assertion_message :: CString -> -- domain : TBasicType TUTF8 CString -> -- file : TBasicType TUTF8 Int32 -> -- line : TBasicType TInt32 CString -> -- func : TBasicType TUTF8 CString -> -- message : TBasicType TUTF8 IO () assertionMessage :: (MonadIO m) => T.Text -> -- domain T.Text -> -- file Int32 -> -- line T.Text -> -- func T.Text -> -- message m () assertionMessage domain file line func message = liftIO $ do domain' <- textToCString domain file' <- textToCString file func' <- textToCString func message' <- textToCString message g_assertion_message domain' file' line func' message' freeMem domain' freeMem file' freeMem func' freeMem message' return () -- function g_assertion_message_cmpstr -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cmp", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cmp", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_assertion_message_cmpstr" g_assertion_message_cmpstr :: CString -> -- domain : TBasicType TUTF8 CString -> -- file : TBasicType TUTF8 Int32 -> -- line : TBasicType TInt32 CString -> -- func : TBasicType TUTF8 CString -> -- expr : TBasicType TUTF8 CString -> -- arg1 : TBasicType TUTF8 CString -> -- cmp : TBasicType TUTF8 CString -> -- arg2 : TBasicType TUTF8 IO () assertionMessageCmpstr :: (MonadIO m) => T.Text -> -- domain T.Text -> -- file Int32 -> -- line T.Text -> -- func T.Text -> -- expr T.Text -> -- arg1 T.Text -> -- cmp T.Text -> -- arg2 m () assertionMessageCmpstr domain file line func expr arg1 cmp arg2 = liftIO $ do domain' <- textToCString domain file' <- textToCString file func' <- textToCString func expr' <- textToCString expr arg1' <- textToCString arg1 cmp' <- textToCString cmp arg2' <- textToCString arg2 g_assertion_message_cmpstr domain' file' line func' expr' arg1' cmp' arg2' freeMem domain' freeMem file' freeMem func' freeMem expr' freeMem arg1' freeMem cmp' freeMem arg2' return () -- function g_assertion_message_error -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_domain", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_code", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_domain", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_code", 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_assertion_message_error" g_assertion_message_error :: CString -> -- domain : TBasicType TUTF8 CString -> -- file : TBasicType TUTF8 Int32 -> -- line : TBasicType TInt32 CString -> -- func : TBasicType TUTF8 CString -> -- expr : TBasicType TUTF8 Ptr GError -> -- error : TError Word32 -> -- error_domain : TBasicType TUInt32 Int32 -> -- error_code : TBasicType TInt32 IO () assertionMessageError :: (MonadIO m) => T.Text -> -- domain T.Text -> -- file Int32 -> -- line T.Text -> -- func T.Text -> -- expr GError -> -- error Word32 -> -- error_domain Int32 -> -- error_code m () assertionMessageError domain file line func expr error_ error_domain error_code = liftIO $ do domain' <- textToCString domain file' <- textToCString file func' <- textToCString func expr' <- textToCString expr let error_' = unsafeManagedPtrGetPtr error_ g_assertion_message_error domain' file' line func' expr' error_' error_domain error_code touchManagedPtr error_ freeMem domain' freeMem file' freeMem func' freeMem expr' return () -- function g_assertion_message_expr -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_assertion_message_expr" g_assertion_message_expr :: CString -> -- domain : TBasicType TUTF8 CString -> -- file : TBasicType TUTF8 Int32 -> -- line : TBasicType TInt32 CString -> -- func : TBasicType TUTF8 CString -> -- expr : TBasicType TUTF8 IO () assertionMessageExpr :: (MonadIO m) => T.Text -> -- domain T.Text -> -- file Int32 -> -- line T.Text -> -- func T.Text -> -- expr m () assertionMessageExpr domain file line func expr = liftIO $ do domain' <- textToCString domain file' <- textToCString file func' <- textToCString func expr' <- textToCString expr g_assertion_message_expr domain' file' line func' expr' freeMem domain' freeMem file' freeMem func' freeMem expr' return () -- function g_atexit -- Args : [Arg {argName = "func", argType = TInterface "GLib" "VoidFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "func", argType = TInterface "GLib" "VoidFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_atexit" g_atexit :: FunPtr VoidFuncC -> -- func : TInterface "GLib" "VoidFunc" IO () {-# DEPRECATED atexit ["(Since version 2.32)","It is best to avoid g_atexit()."]#-} atexit :: (MonadIO m) => VoidFunc -> -- func m () atexit func = liftIO $ do ptrfunc <- callocBytes $ sizeOf (undefined :: FunPtr VoidFuncC) func' <- mkVoidFunc (voidFuncWrapper (Just ptrfunc) func) poke ptrfunc func' g_atexit func' return () -- function g_atomic_int_add -- Args : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_atomic_int_add" g_atomic_int_add :: Int32 -> -- atomic : TBasicType TInt32 Int32 -> -- val : TBasicType TInt32 IO Int32 atomicIntAdd :: (MonadIO m) => Int32 -> -- atomic Int32 -> -- val m Int32 atomicIntAdd atomic val = liftIO $ do result <- g_atomic_int_add atomic val return result -- function g_atomic_int_and -- Args : [Arg {argName = "atomic", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_atomic_int_and" g_atomic_int_and :: Word32 -> -- atomic : TBasicType TUInt32 Word32 -> -- val : TBasicType TUInt32 IO Word32 atomicIntAnd :: (MonadIO m) => Word32 -> -- atomic Word32 -> -- val m Word32 atomicIntAnd atomic val = liftIO $ do result <- g_atomic_int_and atomic val return result -- function g_atomic_int_compare_and_exchange -- Args : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_atomic_int_compare_and_exchange" g_atomic_int_compare_and_exchange :: Int32 -> -- atomic : TBasicType TInt32 Int32 -> -- oldval : TBasicType TInt32 Int32 -> -- newval : TBasicType TInt32 IO CInt atomicIntCompareAndExchange :: (MonadIO m) => Int32 -> -- atomic Int32 -> -- oldval Int32 -> -- newval m Bool atomicIntCompareAndExchange atomic oldval newval = liftIO $ do result <- g_atomic_int_compare_and_exchange atomic oldval newval let result' = (/= 0) result return result' -- function g_atomic_int_dec_and_test -- Args : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_atomic_int_dec_and_test" g_atomic_int_dec_and_test :: Int32 -> -- atomic : TBasicType TInt32 IO CInt atomicIntDecAndTest :: (MonadIO m) => Int32 -> -- atomic m Bool atomicIntDecAndTest atomic = liftIO $ do result <- g_atomic_int_dec_and_test atomic let result' = (/= 0) result return result' -- function g_atomic_int_exchange_and_add -- Args : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_atomic_int_exchange_and_add" g_atomic_int_exchange_and_add :: Int32 -> -- atomic : TBasicType TInt32 Int32 -> -- val : TBasicType TInt32 IO Int32 {-# DEPRECATED atomicIntExchangeAndAdd ["(Since version 2.30)","Use g_atomic_int_add() instead."]#-} atomicIntExchangeAndAdd :: (MonadIO m) => Int32 -> -- atomic Int32 -> -- val m Int32 atomicIntExchangeAndAdd atomic val = liftIO $ do result <- g_atomic_int_exchange_and_add atomic val return result -- function g_atomic_int_get -- Args : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_atomic_int_get" g_atomic_int_get :: Int32 -> -- atomic : TBasicType TInt32 IO Int32 atomicIntGet :: (MonadIO m) => Int32 -> -- atomic m Int32 atomicIntGet atomic = liftIO $ do result <- g_atomic_int_get atomic return result -- function g_atomic_int_inc -- Args : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", 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_atomic_int_inc" g_atomic_int_inc :: Int32 -> -- atomic : TBasicType TInt32 IO () atomicIntInc :: (MonadIO m) => Int32 -> -- atomic m () atomicIntInc atomic = liftIO $ do g_atomic_int_inc atomic return () -- function g_atomic_int_or -- Args : [Arg {argName = "atomic", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_atomic_int_or" g_atomic_int_or :: Word32 -> -- atomic : TBasicType TUInt32 Word32 -> -- val : TBasicType TUInt32 IO Word32 atomicIntOr :: (MonadIO m) => Word32 -> -- atomic Word32 -> -- val m Word32 atomicIntOr atomic val = liftIO $ do result <- g_atomic_int_or atomic val return result -- function g_atomic_int_set -- Args : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", 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_atomic_int_set" g_atomic_int_set :: Int32 -> -- atomic : TBasicType TInt32 Int32 -> -- newval : TBasicType TInt32 IO () atomicIntSet :: (MonadIO m) => Int32 -> -- atomic Int32 -> -- newval m () atomicIntSet atomic newval = liftIO $ do g_atomic_int_set atomic newval return () -- function g_atomic_int_xor -- Args : [Arg {argName = "atomic", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_atomic_int_xor" g_atomic_int_xor :: Word32 -> -- atomic : TBasicType TUInt32 Word32 -> -- val : TBasicType TUInt32 IO Word32 atomicIntXor :: (MonadIO m) => Word32 -> -- atomic Word32 -> -- val m Word32 atomicIntXor atomic val = liftIO $ do result <- g_atomic_int_xor atomic val return result -- function g_atomic_pointer_add -- Args : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_atomic_pointer_add" g_atomic_pointer_add :: Ptr () -> -- atomic : TBasicType TVoid Int64 -> -- val : TBasicType TInt64 IO Int64 atomicPointerAdd :: (MonadIO m) => Ptr () -> -- atomic Int64 -> -- val m Int64 atomicPointerAdd atomic val = liftIO $ do result <- g_atomic_pointer_add atomic val return result -- function g_atomic_pointer_and -- Args : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_atomic_pointer_and" g_atomic_pointer_and :: Ptr () -> -- atomic : TBasicType TVoid Word64 -> -- val : TBasicType TUInt64 IO Word64 atomicPointerAnd :: (MonadIO m) => Ptr () -> -- atomic Word64 -> -- val m Word64 atomicPointerAnd atomic val = liftIO $ do result <- g_atomic_pointer_and atomic val return result -- function g_atomic_pointer_compare_and_exchange -- Args : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_atomic_pointer_compare_and_exchange" g_atomic_pointer_compare_and_exchange :: Ptr () -> -- atomic : TBasicType TVoid Ptr () -> -- oldval : TBasicType TVoid Ptr () -> -- newval : TBasicType TVoid IO CInt atomicPointerCompareAndExchange :: (MonadIO m) => Ptr () -> -- atomic Ptr () -> -- oldval Ptr () -> -- newval m Bool atomicPointerCompareAndExchange atomic oldval newval = liftIO $ do result <- g_atomic_pointer_compare_and_exchange atomic oldval newval let result' = (/= 0) result return result' -- function g_atomic_pointer_or -- Args : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_atomic_pointer_or" g_atomic_pointer_or :: Ptr () -> -- atomic : TBasicType TVoid Word64 -> -- val : TBasicType TUInt64 IO Word64 atomicPointerOr :: (MonadIO m) => Ptr () -> -- atomic Word64 -> -- val m Word64 atomicPointerOr atomic val = liftIO $ do result <- g_atomic_pointer_or atomic val return result -- function g_atomic_pointer_set -- Args : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_atomic_pointer_set" g_atomic_pointer_set :: Ptr () -> -- atomic : TBasicType TVoid Ptr () -> -- newval : TBasicType TVoid IO () atomicPointerSet :: (MonadIO m) => Ptr () -> -- atomic Ptr () -> -- newval m () atomicPointerSet atomic newval = liftIO $ do g_atomic_pointer_set atomic newval return () -- function g_atomic_pointer_xor -- Args : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "atomic", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_atomic_pointer_xor" g_atomic_pointer_xor :: Ptr () -> -- atomic : TBasicType TVoid Word64 -> -- val : TBasicType TUInt64 IO Word64 atomicPointerXor :: (MonadIO m) => Ptr () -> -- atomic Word64 -> -- val m Word64 atomicPointerXor atomic val = liftIO $ do result <- g_atomic_pointer_xor atomic val return result -- function g_base64_decode -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_len", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "out_len", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TUInt8) -- throws : False -- Skip return : False foreign import ccall "g_base64_decode" g_base64_decode :: CString -> -- text : TBasicType TUTF8 Ptr Word64 -> -- out_len : TBasicType TUInt64 IO (Ptr Word8) base64Decode :: (MonadIO m) => T.Text -> -- text m ByteString base64Decode text = liftIO $ do text' <- textToCString text out_len <- allocMem :: IO (Ptr Word64) result <- g_base64_decode text' out_len out_len' <- peek out_len result' <- (unpackByteStringWithLength out_len') result freeMem result freeMem text' freeMem out_len return result' -- function g_base64_decode_inplace -- Args : [Arg {argName = "text", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "out_len", argType = TBasicType TUInt64, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "out_len", argType = TBasicType TUInt64, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "text", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TUInt8 -- throws : False -- Skip return : False foreign import ccall "g_base64_decode_inplace" g_base64_decode_inplace :: Ptr (Ptr Word8) -> -- text : TCArray False (-1) 1 (TBasicType TUInt8) Ptr Word64 -> -- out_len : TBasicType TUInt64 IO Word8 base64DecodeInplace :: (MonadIO m) => ByteString -> -- text m (Word8,ByteString) base64DecodeInplace text = liftIO $ do let out_len = fromIntegral $ B.length text text' <- packByteString text text'' <- allocMem :: IO (Ptr (Ptr Word8)) poke text'' text' out_len' <- allocMem :: IO (Ptr Word64) poke out_len' out_len result <- g_base64_decode_inplace text'' out_len' out_len'' <- peek out_len' text''' <- peek text'' text'''' <- (unpackByteStringWithLength out_len'') text''' freeMem text''' freeMem text'' freeMem out_len' return (result, text'''') -- function g_base64_encode -- Args : [Arg {argName = "data", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "data", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_base64_encode" g_base64_encode :: Ptr Word8 -> -- data : TCArray False (-1) 1 (TBasicType TUInt8) Word64 -> -- len : TBasicType TUInt64 IO CString base64Encode :: (MonadIO m) => ByteString -> -- data m T.Text base64Encode data_ = liftIO $ do let len = fromIntegral $ B.length data_ data_' <- packByteString data_ result <- g_base64_encode data_' len result' <- cstringToText result freeMem result freeMem data_' return result' -- function g_basename -- Args : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_basename" g_basename :: CString -> -- file_name : TBasicType TUTF8 IO CString {-# DEPRECATED basename ["(Since version 2.2)","Use g_path_get_basename() instead, but notice"," that g_path_get_basename() allocates new memory for the"," returned string, unlike this function which returns a pointer"," into the argument."]#-} basename :: (MonadIO m) => T.Text -> -- file_name m T.Text basename file_name = liftIO $ do file_name' <- textToCString file_name result <- g_basename file_name' result' <- cstringToText result freeMem file_name' return result' -- function g_bit_lock -- Args : [Arg {argName = "address", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", 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_bit_lock" g_bit_lock :: Int32 -> -- address : TBasicType TInt32 Int32 -> -- lock_bit : TBasicType TInt32 IO () bitLock :: (MonadIO m) => Int32 -> -- address Int32 -> -- lock_bit m () bitLock address lock_bit = liftIO $ do g_bit_lock address lock_bit return () -- function g_bit_nth_lsf -- Args : [Arg {argName = "mask", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nth_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mask", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nth_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_bit_nth_lsf" g_bit_nth_lsf :: Word64 -> -- mask : TBasicType TUInt64 Int32 -> -- nth_bit : TBasicType TInt32 IO Int32 bitNthLsf :: (MonadIO m) => Word64 -> -- mask Int32 -> -- nth_bit m Int32 bitNthLsf mask nth_bit = liftIO $ do result <- g_bit_nth_lsf mask nth_bit return result -- function g_bit_nth_msf -- Args : [Arg {argName = "mask", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nth_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mask", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nth_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_bit_nth_msf" g_bit_nth_msf :: Word64 -> -- mask : TBasicType TUInt64 Int32 -> -- nth_bit : TBasicType TInt32 IO Int32 bitNthMsf :: (MonadIO m) => Word64 -> -- mask Int32 -> -- nth_bit m Int32 bitNthMsf mask nth_bit = liftIO $ do result <- g_bit_nth_msf mask nth_bit return result -- function g_bit_storage -- Args : [Arg {argName = "number", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "number", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_bit_storage" g_bit_storage :: Word64 -> -- number : TBasicType TUInt64 IO Word32 bitStorage :: (MonadIO m) => Word64 -> -- number m Word32 bitStorage number = liftIO $ do result <- g_bit_storage number return result -- function g_bit_trylock -- Args : [Arg {argName = "address", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_bit_trylock" g_bit_trylock :: Int32 -> -- address : TBasicType TInt32 Int32 -> -- lock_bit : TBasicType TInt32 IO CInt bitTrylock :: (MonadIO m) => Int32 -> -- address Int32 -> -- lock_bit m Bool bitTrylock address lock_bit = liftIO $ do result <- g_bit_trylock address lock_bit let result' = (/= 0) result return result' -- function g_bit_unlock -- Args : [Arg {argName = "address", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", 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_bit_unlock" g_bit_unlock :: Int32 -> -- address : TBasicType TInt32 Int32 -> -- lock_bit : TBasicType TInt32 IO () bitUnlock :: (MonadIO m) => Int32 -> -- address Int32 -> -- lock_bit m () bitUnlock address lock_bit = liftIO $ do g_bit_unlock address lock_bit return () -- function g_bookmark_file_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_bookmark_file_error_quark" g_bookmark_file_error_quark :: IO Word32 bookmarkFileErrorQuark :: (MonadIO m) => m Word32 bookmarkFileErrorQuark = liftIO $ do result <- g_bookmark_file_error_quark return result -- function g_build_filenamev -- Args : [Arg {argName = "args", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "args", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_build_filenamev" g_build_filenamev :: Ptr CString -> -- args : TCArray True (-1) (-1) (TBasicType TUTF8) IO CString buildFilenamev :: (MonadIO m) => [T.Text] -> -- args m T.Text buildFilenamev args = liftIO $ do args' <- packZeroTerminatedUTF8CArray args result <- g_build_filenamev args' result' <- cstringToText result freeMem result mapZeroTerminatedCArray freeMem args' freeMem args' return result' -- function g_build_pathv -- Args : [Arg {argName = "separator", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "args", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "separator", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "args", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_build_pathv" g_build_pathv :: CString -> -- separator : TBasicType TUTF8 Ptr CString -> -- args : TCArray True (-1) (-1) (TBasicType TUTF8) IO CString buildPathv :: (MonadIO m) => T.Text -> -- separator [T.Text] -> -- args m T.Text buildPathv separator args = liftIO $ do separator' <- textToCString separator args' <- packZeroTerminatedUTF8CArray args result <- g_build_pathv separator' args' result' <- cstringToText result freeMem result freeMem separator' mapZeroTerminatedCArray freeMem args' freeMem args' return result' -- function g_byte_array_free -- Args : [Arg {argName = "array", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "free_segment", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "array", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "free_segment", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt8 -- throws : False -- Skip return : False foreign import ccall "g_byte_array_free" g_byte_array_free :: Ptr GByteArray -> -- array : TByteArray CInt -> -- free_segment : TBasicType TBoolean IO Word8 byteArrayFree :: (MonadIO m) => ByteString -> -- array Bool -> -- free_segment m Word8 byteArrayFree array free_segment = liftIO $ do array' <- packGByteArray array let free_segment' = (fromIntegral . fromEnum) free_segment result <- g_byte_array_free array' free_segment' unrefGByteArray array' return result -- function g_byte_array_free_to_bytes -- Args : [Arg {argName = "array", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "array", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TInterface "GLib" "Bytes" -- throws : False -- Skip return : False foreign import ccall "g_byte_array_free_to_bytes" g_byte_array_free_to_bytes :: Ptr GByteArray -> -- array : TByteArray IO (Ptr Bytes) byteArrayFreeToBytes :: (MonadIO m) => ByteString -> -- array m Bytes byteArrayFreeToBytes array = liftIO $ do array' <- packGByteArray array result <- g_byte_array_free_to_bytes array' result' <- (wrapBoxed Bytes) result return result' -- function g_byte_array_new -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TByteArray -- throws : False -- Skip return : False foreign import ccall "g_byte_array_new" g_byte_array_new :: IO (Ptr GByteArray) byteArrayNew :: (MonadIO m) => m ByteString byteArrayNew = liftIO $ do result <- g_byte_array_new result' <- unpackGByteArray result unrefGByteArray result return result' -- function g_byte_array_new_take -- Args : [Arg {argName = "data", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "data", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TByteArray -- throws : False -- Skip return : False foreign import ccall "g_byte_array_new_take" g_byte_array_new_take :: Ptr Word8 -> -- data : TCArray False (-1) 1 (TBasicType TUInt8) Word64 -> -- len : TBasicType TUInt64 IO (Ptr GByteArray) byteArrayNewTake :: (MonadIO m) => ByteString -> -- data m ByteString byteArrayNewTake data_ = liftIO $ do let len = fromIntegral $ B.length data_ data_' <- packByteString data_ result <- g_byte_array_new_take data_' len result' <- unpackGByteArray result unrefGByteArray result return result' -- function g_byte_array_unref -- Args : [Arg {argName = "array", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "array", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_byte_array_unref" g_byte_array_unref :: Ptr GByteArray -> -- array : TByteArray IO () byteArrayUnref :: (MonadIO m) => ByteString -> -- array m () byteArrayUnref array = liftIO $ do array' <- packGByteArray array g_byte_array_unref array' unrefGByteArray array' return () -- function g_chdir -- Args : [Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_chdir" g_chdir :: CString -> -- path : TBasicType TUTF8 IO Int32 chdir :: (MonadIO m) => T.Text -> -- path m Int32 chdir path = liftIO $ do path' <- textToCString path result <- g_chdir path' freeMem path' return result -- function glib_check_version -- Args : [Arg {argName = "required_major", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "required_minor", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "required_micro", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "required_major", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "required_minor", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "required_micro", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "glib_check_version" glib_check_version :: Word32 -> -- required_major : TBasicType TUInt32 Word32 -> -- required_minor : TBasicType TUInt32 Word32 -> -- required_micro : TBasicType TUInt32 IO CString checkVersion :: (MonadIO m) => Word32 -> -- required_major Word32 -> -- required_minor Word32 -> -- required_micro m T.Text checkVersion required_major required_minor required_micro = liftIO $ do result <- glib_check_version required_major required_minor required_micro result' <- cstringToText result return result' -- function g_checksum_type_get_length -- Args : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_checksum_type_get_length" g_checksum_type_get_length :: CUInt -> -- checksum_type : TInterface "GLib" "ChecksumType" IO Int64 checksumTypeGetLength :: (MonadIO m) => ChecksumType -> -- checksum_type m Int64 checksumTypeGetLength checksum_type = liftIO $ do let checksum_type' = (fromIntegral . fromEnum) checksum_type result <- g_checksum_type_get_length checksum_type' return result -- function g_child_watch_add_full -- Args : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pid", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "ChildWatchFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pid", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "ChildWatchFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_child_watch_add_full" g_child_watch_add_full :: Int32 -> -- priority : TBasicType TInt32 Int32 -> -- pid : TBasicType TInt32 FunPtr ChildWatchFuncC -> -- function : TInterface "GLib" "ChildWatchFunc" Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO Word32 childWatchAdd :: (MonadIO m) => Int32 -> -- priority Int32 -> -- pid ChildWatchFunc -> -- function m Word32 childWatchAdd priority pid function = liftIO $ do function' <- mkChildWatchFunc (childWatchFuncWrapper Nothing function) let data_ = castFunPtrToPtr function' let notify = safeFreeFunPtrPtr result <- g_child_watch_add_full priority pid function' data_ notify return result -- function g_child_watch_source_new -- Args : [Arg {argName = "pid", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pid", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_child_watch_source_new" g_child_watch_source_new :: Int32 -> -- pid : TBasicType TInt32 IO (Ptr Source) childWatchSourceNew :: (MonadIO m) => Int32 -> -- pid m Source childWatchSourceNew pid = liftIO $ do result <- g_child_watch_source_new pid result' <- (wrapBoxed Source) result return result' -- function g_clear_error -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : True -- Skip return : False foreign import ccall "g_clear_error" g_clear_error :: Ptr (Ptr GError) -> -- error IO () clearError :: (MonadIO m) => m () clearError = liftIO $ do onException (do propagateGError $ g_clear_error return () ) (do return () ) -- function g_close -- 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 : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_close" g_close :: Int32 -> -- fd : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt close :: (MonadIO m) => Int32 -> -- fd m () close fd = liftIO $ do onException (do _ <- propagateGError $ g_close fd return () ) (do return () ) -- function g_compute_checksum_for_bytes -- Args : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_compute_checksum_for_bytes" g_compute_checksum_for_bytes :: CUInt -> -- checksum_type : TInterface "GLib" "ChecksumType" Ptr Bytes -> -- data : TInterface "GLib" "Bytes" IO CString computeChecksumForBytes :: (MonadIO m) => ChecksumType -> -- checksum_type Bytes -> -- data m T.Text computeChecksumForBytes checksum_type data_ = liftIO $ do let checksum_type' = (fromIntegral . fromEnum) checksum_type let data_' = unsafeManagedPtrGetPtr data_ result <- g_compute_checksum_for_bytes checksum_type' data_' result' <- cstringToText result freeMem result touchManagedPtr data_ return result' -- function g_compute_checksum_for_data -- Args : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_compute_checksum_for_data" g_compute_checksum_for_data :: CUInt -> -- checksum_type : TInterface "GLib" "ChecksumType" Ptr Word8 -> -- data : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- length : TBasicType TUInt64 IO CString computeChecksumForData :: (MonadIO m) => ChecksumType -> -- checksum_type ByteString -> -- data m T.Text computeChecksumForData checksum_type data_ = liftIO $ do let length_ = fromIntegral $ B.length data_ let checksum_type' = (fromIntegral . fromEnum) checksum_type data_' <- packByteString data_ result <- g_compute_checksum_for_data checksum_type' data_' length_ result' <- cstringToText result freeMem result freeMem data_' return result' -- function g_compute_checksum_for_string -- Args : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "checksum_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_compute_checksum_for_string" g_compute_checksum_for_string :: CUInt -> -- checksum_type : TInterface "GLib" "ChecksumType" CString -> -- str : TBasicType TUTF8 Int64 -> -- length : TBasicType TInt64 IO CString computeChecksumForString :: (MonadIO m) => ChecksumType -> -- checksum_type T.Text -> -- str Int64 -> -- length m T.Text computeChecksumForString checksum_type str length_ = liftIO $ do let checksum_type' = (fromIntegral . fromEnum) checksum_type str' <- textToCString str result <- g_compute_checksum_for_string checksum_type' str' length_ result' <- cstringToText result freeMem result freeMem str' return result' -- function g_compute_hmac_for_data -- Args : [Arg {argName = "digest_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "key_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "digest_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_compute_hmac_for_data" g_compute_hmac_for_data :: CUInt -> -- digest_type : TInterface "GLib" "ChecksumType" Ptr Word8 -> -- key : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- key_len : TBasicType TUInt64 Word8 -> -- data : TBasicType TUInt8 Word64 -> -- length : TBasicType TUInt64 IO CString computeHmacForData :: (MonadIO m) => ChecksumType -> -- digest_type ByteString -> -- key Word8 -> -- data Word64 -> -- length m T.Text computeHmacForData digest_type key data_ length_ = liftIO $ do let key_len = fromIntegral $ B.length key let digest_type' = (fromIntegral . fromEnum) digest_type key' <- packByteString key result <- g_compute_hmac_for_data digest_type' key' key_len data_ length_ result' <- cstringToText result freeMem result freeMem key' return result' -- function g_compute_hmac_for_string -- Args : [Arg {argName = "digest_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "key_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "digest_type", argType = TInterface "GLib" "ChecksumType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_compute_hmac_for_string" g_compute_hmac_for_string :: CUInt -> -- digest_type : TInterface "GLib" "ChecksumType" Ptr Word8 -> -- key : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- key_len : TBasicType TUInt64 CString -> -- str : TBasicType TUTF8 Int64 -> -- length : TBasicType TInt64 IO CString computeHmacForString :: (MonadIO m) => ChecksumType -> -- digest_type ByteString -> -- key T.Text -> -- str Int64 -> -- length m T.Text computeHmacForString digest_type key str length_ = liftIO $ do let key_len = fromIntegral $ B.length key let digest_type' = (fromIntegral . fromEnum) digest_type key' <- packByteString key str' <- textToCString str result <- g_compute_hmac_for_string digest_type' key' key_len str' length_ result' <- cstringToText result freeMem result freeMem key' freeMem str' return result' -- function g_convert -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "to_codeset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "from_codeset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes_read", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "to_codeset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "from_codeset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_convert" g_convert :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 CString -> -- to_codeset : TBasicType TUTF8 CString -> -- from_codeset : TBasicType TUTF8 Ptr Word64 -> -- bytes_read : TBasicType TUInt64 Ptr Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString convert :: (MonadIO m) => T.Text -> -- str Int64 -> -- len T.Text -> -- to_codeset T.Text -> -- from_codeset m (T.Text,Word64,Word64) convert str len to_codeset from_codeset = liftIO $ do str' <- textToCString str to_codeset' <- textToCString to_codeset from_codeset' <- textToCString from_codeset bytes_read <- allocMem :: IO (Ptr Word64) bytes_written <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_convert str' len to_codeset' from_codeset' bytes_read bytes_written result' <- cstringToText result freeMem result bytes_read' <- peek bytes_read bytes_written' <- peek bytes_written freeMem str' freeMem to_codeset' freeMem from_codeset' freeMem bytes_read freeMem bytes_written return (result', bytes_read', bytes_written') ) (do freeMem str' freeMem to_codeset' freeMem from_codeset' freeMem bytes_read freeMem bytes_written ) -- function g_convert_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_convert_error_quark" g_convert_error_quark :: IO Word32 convertErrorQuark :: (MonadIO m) => m Word32 convertErrorQuark = liftIO $ do result <- g_convert_error_quark return result -- function g_convert_with_fallback -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "to_codeset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "from_codeset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fallback", argType = TBasicType TUTF8, 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "to_codeset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "from_codeset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fallback", argType = TBasicType TUTF8, 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_convert_with_fallback" g_convert_with_fallback :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 CString -> -- to_codeset : TBasicType TUTF8 CString -> -- from_codeset : TBasicType TUTF8 CString -> -- fallback : TBasicType TUTF8 Word64 -> -- bytes_read : TBasicType TUInt64 Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString convertWithFallback :: (MonadIO m) => T.Text -> -- str Int64 -> -- len T.Text -> -- to_codeset T.Text -> -- from_codeset T.Text -> -- fallback Word64 -> -- bytes_read Word64 -> -- bytes_written m T.Text convertWithFallback str len to_codeset from_codeset fallback bytes_read bytes_written = liftIO $ do str' <- textToCString str to_codeset' <- textToCString to_codeset from_codeset' <- textToCString from_codeset fallback' <- textToCString fallback onException (do result <- propagateGError $ g_convert_with_fallback str' len to_codeset' from_codeset' fallback' bytes_read bytes_written result' <- cstringToText result freeMem result freeMem str' freeMem to_codeset' freeMem from_codeset' freeMem fallback' return result' ) (do freeMem str' freeMem to_codeset' freeMem from_codeset' freeMem fallback' ) -- function g_convert_with_iconv -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "converter", argType = TInterface "GLib" "IConv", 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "converter", argType = TInterface "GLib" "IConv", 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_convert_with_iconv" g_convert_with_iconv :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 Ptr IConv -> -- converter : TInterface "GLib" "IConv" Word64 -> -- bytes_read : TBasicType TUInt64 Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString convertWithIconv :: (MonadIO m) => T.Text -> -- str Int64 -> -- len IConv -> -- converter Word64 -> -- bytes_read Word64 -> -- bytes_written m T.Text convertWithIconv str len converter bytes_read bytes_written = liftIO $ do str' <- textToCString str let converter' = unsafeManagedPtrGetPtr converter onException (do result <- propagateGError $ g_convert_with_iconv str' len converter' bytes_read bytes_written result' <- cstringToText result freeMem result touchManagedPtr converter freeMem str' return result' ) (do freeMem str' ) -- function g_datalist_clear -- Args : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_datalist_clear" g_datalist_clear :: Ptr Data -> -- datalist : TInterface "GLib" "Data" IO () datalistClear :: (MonadIO m) => Data -> -- datalist m () datalistClear datalist = liftIO $ do let datalist' = unsafeManagedPtrGetPtr datalist g_datalist_clear datalist' touchManagedPtr datalist return () -- function g_datalist_get_flags -- Args : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_datalist_get_flags" g_datalist_get_flags :: Ptr Data -> -- datalist : TInterface "GLib" "Data" IO Word32 datalistGetFlags :: (MonadIO m) => Data -> -- datalist m Word32 datalistGetFlags datalist = liftIO $ do let datalist' = unsafeManagedPtrGetPtr datalist result <- g_datalist_get_flags datalist' touchManagedPtr datalist return result -- function g_datalist_id_replace_data -- Args : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_datalist_id_replace_data" g_datalist_id_replace_data :: Ptr Data -> -- datalist : TInterface "GLib" "Data" Word32 -> -- key_id : TBasicType TUInt32 Ptr () -> -- oldval : TBasicType TVoid Ptr () -> -- newval : TBasicType TVoid FunPtr DestroyNotifyC -> -- destroy : TInterface "GLib" "DestroyNotify" FunPtr DestroyNotifyC -> -- old_destroy : TInterface "GLib" "DestroyNotify" IO CInt datalistIdReplaceData :: (MonadIO m) => Data -> -- datalist Word32 -> -- key_id Maybe (Ptr ()) -> -- oldval Maybe (Ptr ()) -> -- newval Maybe (DestroyNotify) -> -- destroy Maybe (DestroyNotify) -> -- old_destroy m Bool datalistIdReplaceData datalist key_id oldval newval destroy old_destroy = liftIO $ do let datalist' = unsafeManagedPtrGetPtr datalist maybeOldval <- case oldval of Nothing -> return nullPtr Just jOldval -> do return jOldval maybeNewval <- case newval of Nothing -> return nullPtr Just jNewval -> do return jNewval ptrdestroy <- callocBytes $ sizeOf (undefined :: FunPtr DestroyNotifyC) maybeDestroy <- case destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jDestroy -> do jDestroy' <- mkDestroyNotify (destroyNotifyWrapper (Just ptrdestroy) jDestroy) poke ptrdestroy jDestroy' return jDestroy' ptrold_destroy <- callocBytes $ sizeOf (undefined :: FunPtr DestroyNotifyC) maybeOld_destroy <- case old_destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jOld_destroy -> do jOld_destroy' <- mkDestroyNotify (destroyNotifyWrapper (Just ptrold_destroy) jOld_destroy) poke ptrold_destroy jOld_destroy' return jOld_destroy' result <- g_datalist_id_replace_data datalist' key_id maybeOldval maybeNewval maybeDestroy maybeOld_destroy let result' = (/= 0) result touchManagedPtr datalist return result' -- function g_datalist_id_set_data_full -- Args : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_datalist_id_set_data_full" g_datalist_id_set_data_full :: Ptr Data -> -- datalist : TInterface "GLib" "Data" Word32 -> -- key_id : TBasicType TUInt32 Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- destroy_func : TInterface "GLib" "DestroyNotify" IO () datalistIdSetDataFull :: (MonadIO m) => Data -> -- datalist Word32 -> -- key_id Maybe (Ptr ()) -> -- data DestroyNotify -> -- destroy_func m () datalistIdSetDataFull datalist key_id data_ destroy_func = liftIO $ do let datalist' = unsafeManagedPtrGetPtr datalist maybeData_ <- case data_ of Nothing -> return nullPtr Just jData_ -> do return jData_ ptrdestroy_func <- callocBytes $ sizeOf (undefined :: FunPtr DestroyNotifyC) destroy_func' <- mkDestroyNotify (destroyNotifyWrapper (Just ptrdestroy_func) destroy_func) poke ptrdestroy_func destroy_func' g_datalist_id_set_data_full datalist' key_id maybeData_ destroy_func' touchManagedPtr datalist return () -- function g_datalist_init -- Args : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_datalist_init" g_datalist_init :: Ptr Data -> -- datalist : TInterface "GLib" "Data" IO () datalistInit :: (MonadIO m) => Data -> -- datalist m () datalistInit datalist = liftIO $ do let datalist' = unsafeManagedPtrGetPtr datalist g_datalist_init datalist' touchManagedPtr datalist return () -- function g_datalist_set_flags -- Args : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_datalist_set_flags" g_datalist_set_flags :: Ptr Data -> -- datalist : TInterface "GLib" "Data" Word32 -> -- flags : TBasicType TUInt32 IO () datalistSetFlags :: (MonadIO m) => Data -> -- datalist Word32 -> -- flags m () datalistSetFlags datalist flags = liftIO $ do let datalist' = unsafeManagedPtrGetPtr datalist g_datalist_set_flags datalist' flags touchManagedPtr datalist return () -- function g_datalist_unset_flags -- Args : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "datalist", argType = TInterface "GLib" "Data", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_datalist_unset_flags" g_datalist_unset_flags :: Ptr Data -> -- datalist : TInterface "GLib" "Data" Word32 -> -- flags : TBasicType TUInt32 IO () datalistUnsetFlags :: (MonadIO m) => Data -> -- datalist Word32 -> -- flags m () datalistUnsetFlags datalist flags = liftIO $ do let datalist' = unsafeManagedPtrGetPtr datalist g_datalist_unset_flags datalist' flags touchManagedPtr datalist return () -- function g_dataset_destroy -- Args : [Arg {argName = "dataset_location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dataset_location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dataset_destroy" g_dataset_destroy :: Ptr () -> -- dataset_location : TBasicType TVoid IO () datasetDestroy :: (MonadIO m) => Ptr () -> -- dataset_location m () datasetDestroy dataset_location = liftIO $ do g_dataset_destroy dataset_location return () -- function g_dataset_id_set_data_full -- Args : [Arg {argName = "dataset_location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dataset_location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dataset_id_set_data_full" g_dataset_id_set_data_full :: Ptr () -> -- dataset_location : TBasicType TVoid Word32 -> -- key_id : TBasicType TUInt32 Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- destroy_func : TInterface "GLib" "DestroyNotify" IO () datasetIdSetDataFull :: (MonadIO m) => Ptr () -> -- dataset_location Word32 -> -- key_id Ptr () -> -- data DestroyNotify -> -- destroy_func m () datasetIdSetDataFull dataset_location key_id data_ destroy_func = liftIO $ do ptrdestroy_func <- callocBytes $ sizeOf (undefined :: FunPtr DestroyNotifyC) destroy_func' <- mkDestroyNotify (destroyNotifyWrapper (Just ptrdestroy_func) destroy_func) poke ptrdestroy_func destroy_func' g_dataset_id_set_data_full dataset_location key_id data_ destroy_func' return () -- function g_date_get_days_in_month -- Args : [Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt8 -- throws : False -- Skip return : False foreign import ccall "g_date_get_days_in_month" g_date_get_days_in_month :: CUInt -> -- month : TInterface "GLib" "DateMonth" Word16 -> -- year : TBasicType TUInt16 IO Word8 dateGetDaysInMonth :: (MonadIO m) => DateMonth -> -- month Word16 -> -- year m Word8 dateGetDaysInMonth month year = liftIO $ do let month' = (fromIntegral . fromEnum) month result <- g_date_get_days_in_month month' year return result -- function g_date_get_monday_weeks_in_year -- Args : [Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt8 -- throws : False -- Skip return : False foreign import ccall "g_date_get_monday_weeks_in_year" g_date_get_monday_weeks_in_year :: Word16 -> -- year : TBasicType TUInt16 IO Word8 dateGetMondayWeeksInYear :: (MonadIO m) => Word16 -> -- year m Word8 dateGetMondayWeeksInYear year = liftIO $ do result <- g_date_get_monday_weeks_in_year year return result -- function g_date_get_sunday_weeks_in_year -- Args : [Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt8 -- throws : False -- Skip return : False foreign import ccall "g_date_get_sunday_weeks_in_year" g_date_get_sunday_weeks_in_year :: Word16 -> -- year : TBasicType TUInt16 IO Word8 dateGetSundayWeeksInYear :: (MonadIO m) => Word16 -> -- year m Word8 dateGetSundayWeeksInYear year = liftIO $ do result <- g_date_get_sunday_weeks_in_year year return result -- function g_date_is_leap_year -- Args : [Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_is_leap_year" g_date_is_leap_year :: Word16 -> -- year : TBasicType TUInt16 IO CInt dateIsLeapYear :: (MonadIO m) => Word16 -> -- year m Bool dateIsLeapYear year = liftIO $ do result <- g_date_is_leap_year year let result' = (/= 0) result return result' -- function g_date_strftime -- Args : [Arg {argName = "s", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "slen", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "date", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "s", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "slen", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "date", argType = TInterface "GLib" "Date", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_date_strftime" g_date_strftime :: CString -> -- s : TBasicType TUTF8 Word64 -> -- slen : TBasicType TUInt64 CString -> -- format : TBasicType TUTF8 Ptr Date -> -- date : TInterface "GLib" "Date" IO Word64 dateStrftime :: (MonadIO m) => T.Text -> -- s Word64 -> -- slen T.Text -> -- format Date -> -- date m Word64 dateStrftime s slen format date = liftIO $ do s' <- textToCString s format' <- textToCString format let date' = unsafeManagedPtrGetPtr date result <- g_date_strftime s' slen format' date' touchManagedPtr date freeMem s' freeMem format' return result -- function g_date_time_compare -- Args : [Arg {argName = "dt1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dt2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dt1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dt2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_compare" g_date_time_compare :: Ptr () -> -- dt1 : TBasicType TVoid Ptr () -> -- dt2 : TBasicType TVoid IO Int32 dateTimeCompare :: (MonadIO m) => Ptr () -> -- dt1 Ptr () -> -- dt2 m Int32 dateTimeCompare dt1 dt2 = liftIO $ do result <- g_date_time_compare dt1 dt2 return result -- function g_date_time_equal -- Args : [Arg {argName = "dt1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dt2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dt1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dt2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_time_equal" g_date_time_equal :: Ptr () -> -- dt1 : TBasicType TVoid Ptr () -> -- dt2 : TBasicType TVoid IO CInt dateTimeEqual :: (MonadIO m) => Ptr () -> -- dt1 Ptr () -> -- dt2 m Bool dateTimeEqual dt1 dt2 = liftIO $ do result <- g_date_time_equal dt1 dt2 let result' = (/= 0) result return result' -- function g_date_time_hash -- Args : [Arg {argName = "datetime", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "datetime", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_date_time_hash" g_date_time_hash :: Ptr () -> -- datetime : TBasicType TVoid IO Word32 dateTimeHash :: (MonadIO m) => Ptr () -> -- datetime m Word32 dateTimeHash datetime = liftIO $ do result <- g_date_time_hash datetime return result -- function g_date_valid_day -- Args : [Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_valid_day" g_date_valid_day :: Word8 -> -- day : TBasicType TUInt8 IO CInt dateValidDay :: (MonadIO m) => Word8 -> -- day m Bool dateValidDay day = liftIO $ do result <- g_date_valid_day day let result' = (/= 0) result return result' -- function g_date_valid_dmy -- Args : [Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "day", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_valid_dmy" g_date_valid_dmy :: Word8 -> -- day : TBasicType TUInt8 CUInt -> -- month : TInterface "GLib" "DateMonth" Word16 -> -- year : TBasicType TUInt16 IO CInt dateValidDmy :: (MonadIO m) => Word8 -> -- day DateMonth -> -- month Word16 -> -- year m Bool dateValidDmy day month year = liftIO $ do let month' = (fromIntegral . fromEnum) month result <- g_date_valid_dmy day month' year let result' = (/= 0) result return result' -- function g_date_valid_julian -- Args : [Arg {argName = "julian_date", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "julian_date", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_valid_julian" g_date_valid_julian :: Word32 -> -- julian_date : TBasicType TUInt32 IO CInt dateValidJulian :: (MonadIO m) => Word32 -> -- julian_date m Bool dateValidJulian julian_date = liftIO $ do result <- g_date_valid_julian julian_date let result' = (/= 0) result return result' -- function g_date_valid_month -- Args : [Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "month", argType = TInterface "GLib" "DateMonth", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_valid_month" g_date_valid_month :: CUInt -> -- month : TInterface "GLib" "DateMonth" IO CInt dateValidMonth :: (MonadIO m) => DateMonth -> -- month m Bool dateValidMonth month = liftIO $ do let month' = (fromIntegral . fromEnum) month result <- g_date_valid_month month' let result' = (/= 0) result return result' -- function g_date_valid_weekday -- Args : [Arg {argName = "weekday", argType = TInterface "GLib" "DateWeekday", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "weekday", argType = TInterface "GLib" "DateWeekday", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_valid_weekday" g_date_valid_weekday :: CUInt -> -- weekday : TInterface "GLib" "DateWeekday" IO CInt dateValidWeekday :: (MonadIO m) => DateWeekday -> -- weekday m Bool dateValidWeekday weekday = liftIO $ do let weekday' = (fromIntegral . fromEnum) weekday result <- g_date_valid_weekday weekday' let result' = (/= 0) result return result' -- function g_date_valid_year -- Args : [Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "year", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_date_valid_year" g_date_valid_year :: Word16 -> -- year : TBasicType TUInt16 IO CInt dateValidYear :: (MonadIO m) => Word16 -> -- year m Bool dateValidYear year = liftIO $ do result <- g_date_valid_year year let result' = (/= 0) result return result' -- function g_dcgettext -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "category", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "category", 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_dcgettext" g_dcgettext :: CString -> -- domain : TBasicType TUTF8 CString -> -- msgid : TBasicType TUTF8 Int32 -> -- category : TBasicType TInt32 IO CString dcgettext :: (MonadIO m) => Maybe (T.Text) -> -- domain T.Text -> -- msgid Int32 -> -- category m T.Text dcgettext domain msgid category = liftIO $ do maybeDomain <- case domain of Nothing -> return nullPtr Just jDomain -> do jDomain' <- textToCString jDomain return jDomain' msgid' <- textToCString msgid result <- g_dcgettext maybeDomain msgid' category result' <- cstringToText result freeMem maybeDomain freeMem msgid' return result' -- function g_dgettext -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dgettext" g_dgettext :: CString -> -- domain : TBasicType TUTF8 CString -> -- msgid : TBasicType TUTF8 IO CString dgettext :: (MonadIO m) => Maybe (T.Text) -> -- domain T.Text -> -- msgid m T.Text dgettext domain msgid = liftIO $ do maybeDomain <- case domain of Nothing -> return nullPtr Just jDomain -> do jDomain' <- textToCString jDomain return jDomain' msgid' <- textToCString msgid result <- g_dgettext maybeDomain msgid' result' <- cstringToText result freeMem maybeDomain freeMem msgid' return result' -- function g_dir_make_tmp -- Args : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TFileName -- throws : True -- Skip return : False foreign import ccall "g_dir_make_tmp" g_dir_make_tmp :: CString -> -- tmpl : TBasicType TFileName Ptr (Ptr GError) -> -- error IO CString dirMakeTmp :: (MonadIO m) => Maybe ([Char]) -> -- tmpl m [Char] dirMakeTmp tmpl = liftIO $ do maybeTmpl <- case tmpl of Nothing -> return nullPtr Just jTmpl -> do jTmpl' <- stringToCString jTmpl return jTmpl' onException (do result <- propagateGError $ g_dir_make_tmp maybeTmpl result' <- cstringToString result freeMem result freeMem maybeTmpl return result' ) (do freeMem maybeTmpl ) -- function g_direct_equal -- Args : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_direct_equal" g_direct_equal :: Ptr () -> -- v1 : TBasicType TVoid Ptr () -> -- v2 : TBasicType TVoid IO CInt directEqual :: (MonadIO m) => Maybe (Ptr ()) -> -- v1 Maybe (Ptr ()) -> -- v2 m Bool directEqual v1 v2 = liftIO $ do maybeV1 <- case v1 of Nothing -> return nullPtr Just jV1 -> do return jV1 maybeV2 <- case v2 of Nothing -> return nullPtr Just jV2 -> do return jV2 result <- g_direct_equal maybeV1 maybeV2 let result' = (/= 0) result return result' -- function g_direct_hash -- Args : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_direct_hash" g_direct_hash :: Ptr () -> -- v : TBasicType TVoid IO Word32 directHash :: (MonadIO m) => Maybe (Ptr ()) -> -- v m Word32 directHash v = liftIO $ do maybeV <- case v of Nothing -> return nullPtr Just jV -> do return jV result <- g_direct_hash maybeV return result -- function g_dngettext -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid_plural", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid_plural", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dngettext" g_dngettext :: CString -> -- domain : TBasicType TUTF8 CString -> -- msgid : TBasicType TUTF8 CString -> -- msgid_plural : TBasicType TUTF8 Word64 -> -- n : TBasicType TUInt64 IO CString dngettext :: (MonadIO m) => Maybe (T.Text) -> -- domain T.Text -> -- msgid T.Text -> -- msgid_plural Word64 -> -- n m T.Text dngettext domain msgid msgid_plural n = liftIO $ do maybeDomain <- case domain of Nothing -> return nullPtr Just jDomain -> do jDomain' <- textToCString jDomain return jDomain' msgid' <- textToCString msgid msgid_plural' <- textToCString msgid_plural result <- g_dngettext maybeDomain msgid' msgid_plural' n result' <- cstringToText result freeMem maybeDomain freeMem msgid' freeMem msgid_plural' return result' -- function g_double_equal -- Args : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_double_equal" g_double_equal :: Ptr () -> -- v1 : TBasicType TVoid Ptr () -> -- v2 : TBasicType TVoid IO CInt doubleEqual :: (MonadIO m) => Ptr () -> -- v1 Ptr () -> -- v2 m Bool doubleEqual v1 v2 = liftIO $ do result <- g_double_equal v1 v2 let result' = (/= 0) result return result' -- function g_double_hash -- Args : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_double_hash" g_double_hash :: Ptr () -> -- v : TBasicType TVoid IO Word32 doubleHash :: (MonadIO m) => Ptr () -> -- v m Word32 doubleHash v = liftIO $ do result <- g_double_hash v return result -- function g_dpgettext -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgctxtid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgidoffset", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgctxtid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgidoffset", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dpgettext" g_dpgettext :: CString -> -- domain : TBasicType TUTF8 CString -> -- msgctxtid : TBasicType TUTF8 Word64 -> -- msgidoffset : TBasicType TUInt64 IO CString dpgettext :: (MonadIO m) => Maybe (T.Text) -> -- domain T.Text -> -- msgctxtid Word64 -> -- msgidoffset m T.Text dpgettext domain msgctxtid msgidoffset = liftIO $ do maybeDomain <- case domain of Nothing -> return nullPtr Just jDomain -> do jDomain' <- textToCString jDomain return jDomain' msgctxtid' <- textToCString msgctxtid result <- g_dpgettext maybeDomain msgctxtid' msgidoffset result' <- cstringToText result freeMem maybeDomain freeMem msgctxtid' return result' -- function g_dpgettext2 -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "context", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "context", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dpgettext2" g_dpgettext2 :: CString -> -- domain : TBasicType TUTF8 CString -> -- context : TBasicType TUTF8 CString -> -- msgid : TBasicType TUTF8 IO CString dpgettext2 :: (MonadIO m) => Maybe (T.Text) -> -- domain T.Text -> -- context T.Text -> -- msgid m T.Text dpgettext2 domain context msgid = liftIO $ do maybeDomain <- case domain of Nothing -> return nullPtr Just jDomain -> do jDomain' <- textToCString jDomain return jDomain' context' <- textToCString context msgid' <- textToCString msgid result <- g_dpgettext2 maybeDomain context' msgid' result' <- cstringToText result freeMem maybeDomain freeMem context' freeMem msgid' return result' -- function g_environ_getenv -- Args : [Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_environ_getenv" g_environ_getenv :: Ptr CString -> -- envp : TCArray True (-1) (-1) (TBasicType TUTF8) CString -> -- variable : TBasicType TUTF8 IO CString environGetenv :: (MonadIO m) => Maybe ([T.Text]) -> -- envp T.Text -> -- variable m T.Text environGetenv envp variable = liftIO $ do maybeEnvp <- case envp of Nothing -> return nullPtr Just jEnvp -> do jEnvp' <- packZeroTerminatedUTF8CArray jEnvp return jEnvp' variable' <- textToCString variable result <- g_environ_getenv maybeEnvp variable' result' <- cstringToText result mapZeroTerminatedCArray freeMem maybeEnvp freeMem maybeEnvp freeMem variable' return result' -- function g_environ_setenv -- Args : [Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "overwrite", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "overwrite", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_environ_setenv" g_environ_setenv :: Ptr CString -> -- envp : TCArray True (-1) (-1) (TBasicType TUTF8) CString -> -- variable : TBasicType TUTF8 CString -> -- value : TBasicType TUTF8 CInt -> -- overwrite : TBasicType TBoolean IO (Ptr CString) environSetenv :: (MonadIO m) => Maybe ([T.Text]) -> -- envp T.Text -> -- variable T.Text -> -- value Bool -> -- overwrite m [T.Text] environSetenv envp variable value overwrite = liftIO $ do maybeEnvp <- case envp of Nothing -> return nullPtr Just jEnvp -> do jEnvp' <- packZeroTerminatedUTF8CArray jEnvp return jEnvp' variable' <- textToCString variable value' <- textToCString value let overwrite' = (fromIntegral . fromEnum) overwrite result <- g_environ_setenv maybeEnvp variable' value' overwrite' result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result freeMem variable' freeMem value' return result' -- function g_environ_unsetenv -- Args : [Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_environ_unsetenv" g_environ_unsetenv :: Ptr CString -> -- envp : TCArray True (-1) (-1) (TBasicType TUTF8) CString -> -- variable : TBasicType TUTF8 IO (Ptr CString) environUnsetenv :: (MonadIO m) => Maybe ([T.Text]) -> -- envp T.Text -> -- variable m [T.Text] environUnsetenv envp variable = liftIO $ do maybeEnvp <- case envp of Nothing -> return nullPtr Just jEnvp -> do jEnvp' <- packZeroTerminatedUTF8CArray jEnvp return jEnvp' variable' <- textToCString variable result <- g_environ_unsetenv maybeEnvp variable' result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result freeMem variable' return result' -- function g_file_error_from_errno -- Args : [Arg {argName = "err_no", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "err_no", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "FileError" -- throws : False -- Skip return : False foreign import ccall "g_file_error_from_errno" g_file_error_from_errno :: Int32 -> -- err_no : TBasicType TInt32 IO CUInt fileErrorFromErrno :: (MonadIO m) => Int32 -> -- err_no m FileError fileErrorFromErrno err_no = liftIO $ do result <- g_file_error_from_errno err_no let result' = (toEnum . fromIntegral) result return result' -- function g_file_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_file_error_quark" g_file_error_quark :: IO Word32 fileErrorQuark :: (MonadIO m) => m Word32 fileErrorQuark = liftIO $ do result <- g_file_error_quark return result -- function g_file_get_contents -- Args : [Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "contents", 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 = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_get_contents" g_file_get_contents :: CString -> -- filename : TBasicType TFileName Ptr (Ptr Word8) -> -- contents : TCArray False (-1) 2 (TBasicType TUInt8) Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CInt fileGetContents :: (MonadIO m) => [Char] -> -- filename m (ByteString) fileGetContents filename = liftIO $ do filename' <- stringToCString filename contents <- allocMem :: IO (Ptr (Ptr Word8)) length_ <- allocMem :: IO (Ptr Word64) onException (do _ <- propagateGError $ g_file_get_contents filename' contents length_ length_' <- peek length_ contents' <- peek contents contents'' <- (unpackByteStringWithLength length_') contents' freeMem contents' freeMem filename' freeMem contents freeMem length_ return contents'' ) (do freeMem filename' freeMem contents freeMem length_ ) -- function g_file_open_tmp -- Args : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_used", argType = TBasicType TFileName, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_file_open_tmp" g_file_open_tmp :: CString -> -- tmpl : TBasicType TFileName Ptr CString -> -- name_used : TBasicType TFileName Ptr (Ptr GError) -> -- error IO Int32 fileOpenTmp :: (MonadIO m) => Maybe ([Char]) -> -- tmpl m (Int32,[Char]) fileOpenTmp tmpl = liftIO $ do maybeTmpl <- case tmpl of Nothing -> return nullPtr Just jTmpl -> do jTmpl' <- stringToCString jTmpl return jTmpl' name_used <- allocMem :: IO (Ptr CString) onException (do result <- propagateGError $ g_file_open_tmp maybeTmpl name_used name_used' <- peek name_used name_used'' <- cstringToString name_used' freeMem name_used' freeMem maybeTmpl freeMem name_used return (result, name_used'') ) (do freeMem maybeTmpl freeMem name_used ) -- function g_file_read_link -- Args : [Arg {argName = "filename", 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}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_file_read_link" g_file_read_link :: CString -> -- filename : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString fileReadLink :: (MonadIO m) => T.Text -> -- filename m T.Text fileReadLink filename = liftIO $ do filename' <- textToCString filename onException (do result <- propagateGError $ g_file_read_link filename' result' <- cstringToText result freeMem result freeMem filename' return result' ) (do freeMem filename' ) -- function g_file_set_contents -- Args : [Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "contents", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "contents", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_contents" g_file_set_contents :: CString -> -- filename : TBasicType TFileName Ptr Word8 -> -- contents : TCArray False (-1) 2 (TBasicType TUInt8) Int64 -> -- length : TBasicType TInt64 Ptr (Ptr GError) -> -- error IO CInt fileSetContents :: (MonadIO m) => [Char] -> -- filename ByteString -> -- contents m () fileSetContents filename contents = liftIO $ do let length_ = fromIntegral $ B.length contents filename' <- stringToCString filename contents' <- packByteString contents onException (do _ <- propagateGError $ g_file_set_contents filename' contents' length_ freeMem filename' freeMem contents' return () ) (do freeMem filename' freeMem contents' ) -- function g_file_test -- Args : [Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test", argType = TInterface "GLib" "FileTest", 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 = "test", argType = TInterface "GLib" "FileTest", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_file_test" g_file_test :: CString -> -- filename : TBasicType TUTF8 CUInt -> -- test : TInterface "GLib" "FileTest" IO CInt fileTest :: (MonadIO m) => T.Text -> -- filename [FileTest] -> -- test m Bool fileTest filename test = liftIO $ do filename' <- textToCString filename let test' = gflagsToWord test result <- g_file_test filename' test' let result' = (/= 0) result freeMem filename' return result' -- function g_filename_display_basename -- Args : [Arg {argName = "filename", 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}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_filename_display_basename" g_filename_display_basename :: CString -> -- filename : TBasicType TUTF8 IO CString filenameDisplayBasename :: (MonadIO m) => T.Text -> -- filename m T.Text filenameDisplayBasename filename = liftIO $ do filename' <- textToCString filename result <- g_filename_display_basename filename' result' <- cstringToText result freeMem result freeMem filename' return result' -- function g_filename_display_name -- Args : [Arg {argName = "filename", 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}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_filename_display_name" g_filename_display_name :: CString -> -- filename : TBasicType TUTF8 IO CString filenameDisplayName :: (MonadIO m) => T.Text -> -- filename m T.Text filenameDisplayName filename = liftIO $ do filename' <- textToCString filename result <- g_filename_display_name filename' result' <- cstringToText result freeMem result freeMem filename' return result' -- function g_filename_from_uri -- Args : [Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TFileName -- throws : True -- Skip return : False foreign import ccall "g_filename_from_uri" g_filename_from_uri :: CString -> -- uri : TBasicType TUTF8 Ptr CString -> -- hostname : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString filenameFromUri :: (MonadIO m) => T.Text -> -- uri m ([Char],T.Text) filenameFromUri uri = liftIO $ do uri' <- textToCString uri hostname <- allocMem :: IO (Ptr CString) onException (do result <- propagateGError $ g_filename_from_uri uri' hostname result' <- cstringToString result freeMem result hostname' <- peek hostname hostname'' <- cstringToText hostname' freeMem hostname' freeMem uri' freeMem hostname return (result', hostname'') ) (do freeMem uri' freeMem hostname ) -- function g_filename_from_utf8 -- Args : [Arg {argName = "utf8string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes_read", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "utf8string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 3 (TBasicType TUInt8) -- throws : True -- Skip return : False foreign import ccall "g_filename_from_utf8" g_filename_from_utf8 :: CString -> -- utf8string : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 Ptr Word64 -> -- bytes_read : TBasicType TUInt64 Ptr Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr Word8) filenameFromUtf8 :: (MonadIO m) => T.Text -> -- utf8string Int64 -> -- len m (ByteString,Word64) filenameFromUtf8 utf8string len = liftIO $ do utf8string' <- textToCString utf8string bytes_read <- allocMem :: IO (Ptr Word64) bytes_written <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_filename_from_utf8 utf8string' len bytes_read bytes_written bytes_written' <- peek bytes_written result' <- (unpackByteStringWithLength bytes_written') result freeMem result bytes_read' <- peek bytes_read freeMem utf8string' freeMem bytes_read freeMem bytes_written return (result', bytes_read') ) (do freeMem utf8string' freeMem bytes_read freeMem bytes_written ) -- function g_filename_to_uri -- Args : [Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, 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 = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_filename_to_uri" g_filename_to_uri :: CString -> -- filename : TBasicType TUTF8 CString -> -- hostname : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString filenameToUri :: (MonadIO m) => T.Text -> -- filename Maybe (T.Text) -> -- hostname m T.Text filenameToUri filename hostname = liftIO $ do filename' <- textToCString filename maybeHostname <- case hostname of Nothing -> return nullPtr Just jHostname -> do jHostname' <- textToCString jHostname return jHostname' onException (do result <- propagateGError $ g_filename_to_uri filename' maybeHostname result' <- cstringToText result freeMem result freeMem filename' freeMem maybeHostname return result' ) (do freeMem filename' freeMem maybeHostname ) -- function g_filename_to_utf8 -- Args : [Arg {argName = "opsysstring", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "opsysstring", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_filename_to_utf8" g_filename_to_utf8 :: CString -> -- opsysstring : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 Word64 -> -- bytes_read : TBasicType TUInt64 Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString filenameToUtf8 :: (MonadIO m) => T.Text -> -- opsysstring Int64 -> -- len Word64 -> -- bytes_read Word64 -> -- bytes_written m T.Text filenameToUtf8 opsysstring len bytes_read bytes_written = liftIO $ do opsysstring' <- textToCString opsysstring onException (do result <- propagateGError $ g_filename_to_utf8 opsysstring' len bytes_read bytes_written result' <- cstringToText result freeMem result freeMem opsysstring' return result' ) (do freeMem opsysstring' ) -- function g_find_program_in_path -- Args : [Arg {argName = "program", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "program", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_find_program_in_path" g_find_program_in_path :: CString -> -- program : TBasicType TUTF8 IO CString findProgramInPath :: (MonadIO m) => T.Text -> -- program m T.Text findProgramInPath program = liftIO $ do program' <- textToCString program result <- g_find_program_in_path program' result' <- cstringToText result freeMem result freeMem program' return result' -- function g_format_size -- Args : [Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_format_size" g_format_size :: Word64 -> -- size : TBasicType TUInt64 IO CString formatSize :: (MonadIO m) => Word64 -> -- size m T.Text formatSize size = liftIO $ do result <- g_format_size size result' <- cstringToText result freeMem result return result' -- function g_format_size_for_display -- Args : [Arg {argName = "size", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "size", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_format_size_for_display" g_format_size_for_display :: Int64 -> -- size : TBasicType TInt64 IO CString {-# DEPRECATED formatSizeForDisplay ["(Since version 2.30)","This function is broken due to its use of SI"," suffixes to denote IEC units. Use g_format_size() instead."]#-} formatSizeForDisplay :: (MonadIO m) => Int64 -> -- size m T.Text formatSizeForDisplay size = liftIO $ do result <- g_format_size_for_display size result' <- cstringToText result freeMem result return result' -- function g_format_size_full -- Args : [Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "FormatSizeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "FormatSizeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_format_size_full" g_format_size_full :: Word64 -> -- size : TBasicType TUInt64 CUInt -> -- flags : TInterface "GLib" "FormatSizeFlags" IO CString formatSizeFull :: (MonadIO m) => Word64 -> -- size [FormatSizeFlags] -> -- flags m T.Text formatSizeFull size flags = liftIO $ do let flags' = gflagsToWord flags result <- g_format_size_full size flags' result' <- cstringToText result freeMem result return result' -- function g_free -- Args : [Arg {argName = "mem", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mem", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_free" g_free :: Ptr () -> -- mem : TBasicType TVoid IO () free :: (MonadIO m) => Maybe (Ptr ()) -> -- mem m () free mem = liftIO $ do maybeMem <- case mem of Nothing -> return nullPtr Just jMem -> do return jMem g_free maybeMem return () -- function g_get_application_name -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_application_name" g_get_application_name :: IO CString getApplicationName :: (MonadIO m) => m T.Text getApplicationName = liftIO $ do result <- g_get_application_name result' <- cstringToText result return result' -- function g_get_charset -- Args : [Arg {argName = "charset", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_get_charset" g_get_charset :: Ptr CString -> -- charset : TBasicType TUTF8 IO CInt getCharset :: (MonadIO m) => m (Bool,T.Text) getCharset = liftIO $ do charset <- allocMem :: IO (Ptr CString) result <- g_get_charset charset let result' = (/= 0) result charset' <- peek charset charset'' <- cstringToText charset' freeMem charset return (result', charset'') -- function g_get_codeset -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_codeset" g_get_codeset :: IO CString getCodeset :: (MonadIO m) => m T.Text getCodeset = liftIO $ do result <- g_get_codeset result' <- cstringToText result freeMem result return result' -- function g_get_current_dir -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_current_dir" g_get_current_dir :: IO CString getCurrentDir :: (MonadIO m) => m T.Text getCurrentDir = liftIO $ do result <- g_get_current_dir result' <- cstringToText result freeMem result return result' -- function g_get_current_time -- Args : [Arg {argName = "result", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "result", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_get_current_time" g_get_current_time :: Ptr TimeVal -> -- result : TInterface "GLib" "TimeVal" IO () getCurrentTime :: (MonadIO m) => TimeVal -> -- result m () getCurrentTime result_ = liftIO $ do let result_' = unsafeManagedPtrGetPtr result_ g_get_current_time result_' touchManagedPtr result_ return () -- function g_get_environ -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_get_environ" g_get_environ :: IO (Ptr CString) getEnviron :: (MonadIO m) => m [T.Text] getEnviron = liftIO $ do result <- g_get_environ result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result return result' -- function g_get_filename_charsets -- Args : [Arg {argName = "charsets", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "charsets", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_get_filename_charsets" g_get_filename_charsets :: CString -> -- charsets : TBasicType TUTF8 IO CInt getFilenameCharsets :: (MonadIO m) => T.Text -> -- charsets m Bool getFilenameCharsets charsets = liftIO $ do charsets' <- textToCString charsets result <- g_get_filename_charsets charsets' let result' = (/= 0) result freeMem charsets' return result' -- function g_get_home_dir -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_home_dir" g_get_home_dir :: IO CString getHomeDir :: (MonadIO m) => m T.Text getHomeDir = liftIO $ do result <- g_get_home_dir result' <- cstringToText result return result' -- function g_get_host_name -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_host_name" g_get_host_name :: IO CString getHostName :: (MonadIO m) => m T.Text getHostName = liftIO $ do result <- g_get_host_name result' <- cstringToText result return result' -- function g_get_language_names -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_get_language_names" g_get_language_names :: IO (Ptr CString) getLanguageNames :: (MonadIO m) => m [T.Text] getLanguageNames = liftIO $ do result <- g_get_language_names result' <- unpackZeroTerminatedUTF8CArray result return result' -- function g_get_locale_variants -- Args : [Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_get_locale_variants" g_get_locale_variants :: CString -> -- locale : TBasicType TUTF8 IO (Ptr CString) getLocaleVariants :: (MonadIO m) => T.Text -> -- locale m [T.Text] getLocaleVariants locale = liftIO $ do locale' <- textToCString locale result <- g_get_locale_variants locale' result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result freeMem locale' return result' -- function g_get_monotonic_time -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_get_monotonic_time" g_get_monotonic_time :: IO Int64 getMonotonicTime :: (MonadIO m) => m Int64 getMonotonicTime = liftIO $ do result <- g_get_monotonic_time return result -- function g_get_num_processors -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_get_num_processors" g_get_num_processors :: IO Word32 getNumProcessors :: (MonadIO m) => m Word32 getNumProcessors = liftIO $ do result <- g_get_num_processors return result -- function g_get_prgname -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_prgname" g_get_prgname :: IO CString getPrgname :: (MonadIO m) => m T.Text getPrgname = liftIO $ do result <- g_get_prgname result' <- cstringToText result return result' -- function g_get_real_name -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_real_name" g_get_real_name :: IO CString getRealName :: (MonadIO m) => m T.Text getRealName = liftIO $ do result <- g_get_real_name result' <- cstringToText result return result' -- function g_get_real_time -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_get_real_time" g_get_real_time :: IO Int64 getRealTime :: (MonadIO m) => m Int64 getRealTime = liftIO $ do result <- g_get_real_time return result -- function g_get_system_config_dirs -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_get_system_config_dirs" g_get_system_config_dirs :: IO (Ptr CString) getSystemConfigDirs :: (MonadIO m) => m [T.Text] getSystemConfigDirs = liftIO $ do result <- g_get_system_config_dirs result' <- unpackZeroTerminatedUTF8CArray result return result' -- function g_get_system_data_dirs -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_get_system_data_dirs" g_get_system_data_dirs :: IO (Ptr CString) getSystemDataDirs :: (MonadIO m) => m [T.Text] getSystemDataDirs = liftIO $ do result <- g_get_system_data_dirs result' <- unpackZeroTerminatedUTF8CArray result return result' -- function g_get_tmp_dir -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_tmp_dir" g_get_tmp_dir :: IO CString getTmpDir :: (MonadIO m) => m T.Text getTmpDir = liftIO $ do result <- g_get_tmp_dir result' <- cstringToText result return result' -- function g_get_user_cache_dir -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_user_cache_dir" g_get_user_cache_dir :: IO CString getUserCacheDir :: (MonadIO m) => m T.Text getUserCacheDir = liftIO $ do result <- g_get_user_cache_dir result' <- cstringToText result return result' -- function g_get_user_config_dir -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_user_config_dir" g_get_user_config_dir :: IO CString getUserConfigDir :: (MonadIO m) => m T.Text getUserConfigDir = liftIO $ do result <- g_get_user_config_dir result' <- cstringToText result return result' -- function g_get_user_data_dir -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_user_data_dir" g_get_user_data_dir :: IO CString getUserDataDir :: (MonadIO m) => m T.Text getUserDataDir = liftIO $ do result <- g_get_user_data_dir result' <- cstringToText result return result' -- function g_get_user_name -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_user_name" g_get_user_name :: IO CString getUserName :: (MonadIO m) => m T.Text getUserName = liftIO $ do result <- g_get_user_name result' <- cstringToText result return result' -- function g_get_user_runtime_dir -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_user_runtime_dir" g_get_user_runtime_dir :: IO CString getUserRuntimeDir :: (MonadIO m) => m T.Text getUserRuntimeDir = liftIO $ do result <- g_get_user_runtime_dir result' <- cstringToText result return result' -- function g_get_user_special_dir -- Args : [Arg {argName = "directory", argType = TInterface "GLib" "UserDirectory", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "directory", argType = TInterface "GLib" "UserDirectory", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_get_user_special_dir" g_get_user_special_dir :: CUInt -> -- directory : TInterface "GLib" "UserDirectory" IO CString getUserSpecialDir :: (MonadIO m) => UserDirectory -> -- directory m T.Text getUserSpecialDir directory = liftIO $ do let directory' = (fromIntegral . fromEnum) directory result <- g_get_user_special_dir directory' result' <- cstringToText result return result' -- function g_getenv -- Args : [Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_getenv" g_getenv :: CString -> -- variable : TBasicType TUTF8 IO CString getenv :: (MonadIO m) => T.Text -> -- variable m T.Text getenv variable = liftIO $ do variable' <- textToCString variable result <- g_getenv variable' result' <- cstringToText result freeMem variable' return result' -- function g_hash_table_add -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hash_table_add" g_hash_table_add :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) Ptr () -> -- key : TBasicType TVoid IO CInt hashTableAdd :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table Ptr () -> -- key m Bool hashTableAdd hash_table key = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' result <- g_hash_table_add hash_table'''' key let result' = (/= 0) result unrefGHashTable hash_table'''' return result' -- function g_hash_table_contains -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hash_table_contains" g_hash_table_contains :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) Ptr () -> -- key : TBasicType TVoid IO CInt hashTableContains :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table Ptr () -> -- key m Bool hashTableContains hash_table key = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' result <- g_hash_table_contains hash_table'''' key let result' = (/= 0) result unrefGHashTable hash_table'''' return result' -- function g_hash_table_destroy -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hash_table_destroy" g_hash_table_destroy :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) IO () hashTableDestroy :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table m () hashTableDestroy hash_table = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' g_hash_table_destroy hash_table'''' unrefGHashTable hash_table'''' return () -- function g_hash_table_insert -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hash_table_insert" g_hash_table_insert :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) Ptr () -> -- key : TBasicType TVoid Ptr () -> -- value : TBasicType TVoid IO CInt hashTableInsert :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table Ptr () -> -- key Ptr () -> -- value m Bool hashTableInsert hash_table key value = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' result <- g_hash_table_insert hash_table'''' key value let result' = (/= 0) result unrefGHashTable hash_table'''' return result' -- function g_hash_table_lookup_extended -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "orig_key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "orig_key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hash_table_lookup_extended" g_hash_table_lookup_extended :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) Ptr () -> -- lookup_key : TBasicType TVoid Ptr () -> -- orig_key : TBasicType TVoid Ptr () -> -- value : TBasicType TVoid IO CInt hashTableLookupExtended :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table Ptr () -> -- lookup_key Maybe (Ptr ()) -> -- orig_key Maybe (Ptr ()) -> -- value m Bool hashTableLookupExtended hash_table lookup_key orig_key value = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' maybeOrig_key <- case orig_key of Nothing -> return nullPtr Just jOrig_key -> do return jOrig_key maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do return jValue result <- g_hash_table_lookup_extended hash_table'''' lookup_key maybeOrig_key maybeValue let result' = (/= 0) result unrefGHashTable hash_table'''' return result' -- function g_hash_table_remove -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hash_table_remove" g_hash_table_remove :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) Ptr () -> -- key : TBasicType TVoid IO CInt hashTableRemove :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table Ptr () -> -- key m Bool hashTableRemove hash_table key = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' result <- g_hash_table_remove hash_table'''' key let result' = (/= 0) result unrefGHashTable hash_table'''' return result' -- function g_hash_table_remove_all -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hash_table_remove_all" g_hash_table_remove_all :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) IO () hashTableRemoveAll :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table m () hashTableRemoveAll hash_table = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' g_hash_table_remove_all hash_table'''' unrefGHashTable hash_table'''' return () -- function g_hash_table_replace -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hash_table_replace" g_hash_table_replace :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) Ptr () -> -- key : TBasicType TVoid Ptr () -> -- value : TBasicType TVoid IO CInt hashTableReplace :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table Ptr () -> -- key Ptr () -> -- value m Bool hashTableReplace hash_table key value = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' result <- g_hash_table_replace hash_table'''' key value let result' = (/= 0) result unrefGHashTable hash_table'''' return result' -- function g_hash_table_size -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_hash_table_size" g_hash_table_size :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) IO Word32 hashTableSize :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table m Word32 hashTableSize hash_table = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' result <- g_hash_table_size hash_table'''' unrefGHashTable hash_table'''' return result -- function g_hash_table_steal -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hash_table_steal" g_hash_table_steal :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) Ptr () -> -- key : TBasicType TVoid IO CInt hashTableSteal :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table Ptr () -> -- key m Bool hashTableSteal hash_table key = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' result <- g_hash_table_steal hash_table'''' key let result' = (/= 0) result unrefGHashTable hash_table'''' return result' -- function g_hash_table_steal_all -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hash_table_steal_all" g_hash_table_steal_all :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) IO () hashTableStealAll :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table m () hashTableStealAll hash_table = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' g_hash_table_steal_all hash_table'''' unrefGHashTable hash_table'''' return () -- function g_hash_table_unref -- Args : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hash_table", argType = TGHash (TBasicType TVoid) (TBasicType TVoid), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hash_table_unref" g_hash_table_unref :: Ptr (GHashTable (Ptr ()) (Ptr ())) -> -- hash_table : TGHash (TBasicType TVoid) (TBasicType TVoid) IO () hashTableUnref :: (MonadIO m) => Map.Map (Ptr ()) (Ptr ()) -> -- hash_table m () hashTableUnref hash_table = liftIO $ do let hash_table' = Map.toList hash_table let hash_table'' = mapFirst ptrPackPtr hash_table' let hash_table''' = mapSecond ptrPackPtr hash_table'' hash_table'''' <- packGHashTable gDirectHash gDirectEqual Nothing Nothing hash_table''' g_hash_table_unref hash_table'''' unrefGHashTable hash_table'''' return () -- function g_hook_destroy -- Args : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hook_destroy" g_hook_destroy :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Word64 -> -- hook_id : TBasicType TUInt64 IO CInt hookDestroy :: (MonadIO m) => HookList -> -- hook_list Word64 -> -- hook_id m Bool hookDestroy hook_list hook_id = liftIO $ do let hook_list' = unsafeManagedPtrGetPtr hook_list result <- g_hook_destroy hook_list' hook_id let result' = (/= 0) result touchManagedPtr hook_list return result' -- function g_hook_destroy_link -- Args : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hook_destroy_link" g_hook_destroy_link :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookDestroyLink :: (MonadIO m) => HookList -> -- hook_list Hook -> -- hook m () hookDestroyLink hook_list hook = liftIO $ do let hook_list' = unsafeManagedPtrGetPtr hook_list let hook' = unsafeManagedPtrGetPtr hook g_hook_destroy_link hook_list' hook' touchManagedPtr hook_list touchManagedPtr hook return () -- function g_hook_free -- Args : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hook_free" g_hook_free :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookFree :: (MonadIO m) => HookList -> -- hook_list Hook -> -- hook m () hookFree hook_list hook = liftIO $ do let hook_list' = unsafeManagedPtrGetPtr hook_list let hook' = unsafeManagedPtrGetPtr hook g_hook_free hook_list' hook' touchManagedPtr hook_list touchManagedPtr hook return () -- function g_hook_insert_before -- Args : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sibling", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sibling", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hook_insert_before" g_hook_insert_before :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- sibling : TInterface "GLib" "Hook" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookInsertBefore :: (MonadIO m) => HookList -> -- hook_list Hook -> -- sibling Hook -> -- hook m () hookInsertBefore hook_list sibling hook = liftIO $ do let hook_list' = unsafeManagedPtrGetPtr hook_list let sibling' = unsafeManagedPtrGetPtr sibling let hook' = unsafeManagedPtrGetPtr hook g_hook_insert_before hook_list' sibling' hook' touchManagedPtr hook_list touchManagedPtr sibling touchManagedPtr hook return () -- function g_hook_prepend -- Args : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hook_prepend" g_hook_prepend :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookPrepend :: (MonadIO m) => HookList -> -- hook_list Hook -> -- hook m () hookPrepend hook_list hook = liftIO $ do let hook_list' = unsafeManagedPtrGetPtr hook_list let hook' = unsafeManagedPtrGetPtr hook g_hook_prepend hook_list' hook' touchManagedPtr hook_list touchManagedPtr hook return () -- function g_hook_unref -- Args : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_hook_unref" g_hook_unref :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookUnref :: (MonadIO m) => HookList -> -- hook_list Hook -> -- hook m () hookUnref hook_list hook = liftIO $ do let hook_list' = unsafeManagedPtrGetPtr hook_list let hook' = unsafeManagedPtrGetPtr hook g_hook_unref hook_list' hook' touchManagedPtr hook_list touchManagedPtr hook return () -- function g_hostname_is_ascii_encoded -- Args : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hostname_is_ascii_encoded" g_hostname_is_ascii_encoded :: CString -> -- hostname : TBasicType TUTF8 IO CInt hostnameIsAsciiEncoded :: (MonadIO m) => T.Text -> -- hostname m Bool hostnameIsAsciiEncoded hostname = liftIO $ do hostname' <- textToCString hostname result <- g_hostname_is_ascii_encoded hostname' let result' = (/= 0) result freeMem hostname' return result' -- function g_hostname_is_ip_address -- Args : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hostname_is_ip_address" g_hostname_is_ip_address :: CString -> -- hostname : TBasicType TUTF8 IO CInt hostnameIsIpAddress :: (MonadIO m) => T.Text -> -- hostname m Bool hostnameIsIpAddress hostname = liftIO $ do hostname' <- textToCString hostname result <- g_hostname_is_ip_address hostname' let result' = (/= 0) result freeMem hostname' return result' -- function g_hostname_is_non_ascii -- Args : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_hostname_is_non_ascii" g_hostname_is_non_ascii :: CString -> -- hostname : TBasicType TUTF8 IO CInt hostnameIsNonAscii :: (MonadIO m) => T.Text -> -- hostname m Bool hostnameIsNonAscii hostname = liftIO $ do hostname' <- textToCString hostname result <- g_hostname_is_non_ascii hostname' let result' = (/= 0) result freeMem hostname' return result' -- function g_hostname_to_ascii -- Args : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_hostname_to_ascii" g_hostname_to_ascii :: CString -> -- hostname : TBasicType TUTF8 IO CString hostnameToAscii :: (MonadIO m) => T.Text -> -- hostname m T.Text hostnameToAscii hostname = liftIO $ do hostname' <- textToCString hostname result <- g_hostname_to_ascii hostname' result' <- cstringToText result freeMem result freeMem hostname' return result' -- function g_hostname_to_unicode -- Args : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_hostname_to_unicode" g_hostname_to_unicode :: CString -> -- hostname : TBasicType TUTF8 IO CString hostnameToUnicode :: (MonadIO m) => T.Text -> -- hostname m T.Text hostnameToUnicode hostname = liftIO $ do hostname' <- textToCString hostname result <- g_hostname_to_unicode hostname' result' <- cstringToText result freeMem result freeMem hostname' return result' -- function g_iconv -- Args : [Arg {argName = "converter", argType = TInterface "GLib" "IConv", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inbuf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inbytes_left", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbuf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbytes_left", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "converter", argType = TInterface "GLib" "IConv", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inbuf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inbytes_left", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbuf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbytes_left", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_iconv" g_iconv :: Ptr IConv -> -- converter : TInterface "GLib" "IConv" CString -> -- inbuf : TBasicType TUTF8 Word64 -> -- inbytes_left : TBasicType TUInt64 CString -> -- outbuf : TBasicType TUTF8 Word64 -> -- outbytes_left : TBasicType TUInt64 IO Word64 iconv :: (MonadIO m) => IConv -> -- converter T.Text -> -- inbuf Word64 -> -- inbytes_left T.Text -> -- outbuf Word64 -> -- outbytes_left m Word64 iconv converter inbuf inbytes_left outbuf outbytes_left = liftIO $ do let converter' = unsafeManagedPtrGetPtr converter inbuf' <- textToCString inbuf outbuf' <- textToCString outbuf result <- g_iconv converter' inbuf' inbytes_left outbuf' outbytes_left touchManagedPtr converter freeMem inbuf' freeMem outbuf' return result -- function g_idle_add_full -- Args : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_idle_add_full" g_idle_add_full :: Int32 -> -- priority : TBasicType TInt32 FunPtr SourceFuncC -> -- function : TInterface "GLib" "SourceFunc" Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO Word32 idleAdd :: (MonadIO m) => Int32 -> -- priority SourceFunc -> -- function m Word32 idleAdd priority function = liftIO $ do function' <- mkSourceFunc (sourceFuncWrapper Nothing function) let data_ = castFunPtrToPtr function' let notify = safeFreeFunPtrPtr result <- g_idle_add_full priority function' data_ notify return result -- function g_idle_remove_by_data -- Args : [Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_idle_remove_by_data" g_idle_remove_by_data :: Ptr () -> -- data : TBasicType TVoid IO CInt idleRemoveByData :: (MonadIO m) => Ptr () -> -- data m Bool idleRemoveByData data_ = liftIO $ do result <- g_idle_remove_by_data data_ let result' = (/= 0) result return result' -- function g_idle_source_new -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_idle_source_new" g_idle_source_new :: IO (Ptr Source) idleSourceNew :: (MonadIO m) => m Source idleSourceNew = liftIO $ do result <- g_idle_source_new result' <- (wrapBoxed Source) result return result' -- function g_int64_equal -- Args : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_int64_equal" g_int64_equal :: Ptr () -> -- v1 : TBasicType TVoid Ptr () -> -- v2 : TBasicType TVoid IO CInt int64Equal :: (MonadIO m) => Ptr () -> -- v1 Ptr () -> -- v2 m Bool int64Equal v1 v2 = liftIO $ do result <- g_int64_equal v1 v2 let result' = (/= 0) result return result' -- function g_int64_hash -- Args : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_int64_hash" g_int64_hash :: Ptr () -> -- v : TBasicType TVoid IO Word32 int64Hash :: (MonadIO m) => Ptr () -> -- v m Word32 int64Hash v = liftIO $ do result <- g_int64_hash v return result -- function g_int_equal -- Args : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_int_equal" g_int_equal :: Ptr () -> -- v1 : TBasicType TVoid Ptr () -> -- v2 : TBasicType TVoid IO CInt intEqual :: (MonadIO m) => Ptr () -> -- v1 Ptr () -> -- v2 m Bool intEqual v1 v2 = liftIO $ do result <- g_int_equal v1 v2 let result' = (/= 0) result return result' -- function g_int_hash -- Args : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_int_hash" g_int_hash :: Ptr () -> -- v : TBasicType TVoid IO Word32 intHash :: (MonadIO m) => Ptr () -> -- v m Word32 intHash v = liftIO $ do result <- g_int_hash v return result -- function g_intern_static_string -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_intern_static_string" g_intern_static_string :: CString -> -- string : TBasicType TUTF8 IO CString internStaticString :: (MonadIO m) => Maybe (T.Text) -> -- string m T.Text internStaticString string = liftIO $ do maybeString <- case string of Nothing -> return nullPtr Just jString -> do jString' <- textToCString jString return jString' result <- g_intern_static_string maybeString result' <- cstringToText result freeMem maybeString return result' -- function g_intern_string -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_intern_string" g_intern_string :: CString -> -- string : TBasicType TUTF8 IO CString internString :: (MonadIO m) => Maybe (T.Text) -> -- string m T.Text internString string = liftIO $ do maybeString <- case string of Nothing -> return nullPtr Just jString -> do jString' <- textToCString jString return jString' result <- g_intern_string maybeString result' <- cstringToText result freeMem maybeString return result' -- function g_io_add_watch_full -- Args : [Arg {argName = "channel", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "condition", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "GLib" "IOFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 4, argDestroy = 5, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "channel", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "condition", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "GLib" "IOFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 4, argDestroy = 5, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_io_add_watch_full" g_io_add_watch_full :: Ptr IOChannel -> -- channel : TInterface "GLib" "IOChannel" Int32 -> -- priority : TBasicType TInt32 CUInt -> -- condition : TInterface "GLib" "IOCondition" FunPtr IOFuncC -> -- func : TInterface "GLib" "IOFunc" Ptr () -> -- user_data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO Word32 ioAddWatch :: (MonadIO m) => IOChannel -> -- channel Int32 -> -- priority [IOCondition] -> -- condition IOFunc -> -- func m Word32 ioAddWatch channel priority condition func = liftIO $ do let channel' = unsafeManagedPtrGetPtr channel let condition' = gflagsToWord condition func' <- mkIOFunc (iOFuncWrapper Nothing func) let user_data = castFunPtrToPtr func' let notify = safeFreeFunPtrPtr result <- g_io_add_watch_full channel' priority condition' func' user_data notify touchManagedPtr channel return result -- function g_io_channel_error_from_errno -- Args : [Arg {argName = "en", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "en", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "IOChannelError" -- throws : False -- Skip return : False foreign import ccall "g_io_channel_error_from_errno" g_io_channel_error_from_errno :: Int32 -> -- en : TBasicType TInt32 IO CUInt ioChannelErrorFromErrno :: (MonadIO m) => Int32 -> -- en m IOChannelError ioChannelErrorFromErrno en = liftIO $ do result <- g_io_channel_error_from_errno en let result' = (toEnum . fromIntegral) result return result' -- function g_io_channel_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_io_channel_error_quark" g_io_channel_error_quark :: IO Word32 ioChannelErrorQuark :: (MonadIO m) => m Word32 ioChannelErrorQuark = liftIO $ do result <- g_io_channel_error_quark return result -- function g_io_create_watch -- Args : [Arg {argName = "channel", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "condition", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "channel", argType = TInterface "GLib" "IOChannel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "condition", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_io_create_watch" g_io_create_watch :: Ptr IOChannel -> -- channel : TInterface "GLib" "IOChannel" CUInt -> -- condition : TInterface "GLib" "IOCondition" IO (Ptr Source) ioCreateWatch :: (MonadIO m) => IOChannel -> -- channel [IOCondition] -> -- condition m Source ioCreateWatch channel condition = liftIO $ do let channel' = unsafeManagedPtrGetPtr channel let condition' = gflagsToWord condition result <- g_io_create_watch channel' condition' result' <- (wrapBoxed Source) result touchManagedPtr channel return result' -- function g_key_file_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_key_file_error_quark" g_key_file_error_quark :: IO Word32 keyFileErrorQuark :: (MonadIO m) => m Word32 keyFileErrorQuark = liftIO $ do result <- g_key_file_error_quark return result -- function g_listenv -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_listenv" g_listenv :: IO (Ptr CString) listenv :: (MonadIO m) => m [T.Text] listenv = liftIO $ do result <- g_listenv result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result return result' -- function g_locale_from_utf8 -- Args : [Arg {argName = "utf8string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "utf8string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_locale_from_utf8" g_locale_from_utf8 :: CString -> -- utf8string : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 Word64 -> -- bytes_read : TBasicType TUInt64 Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString localeFromUtf8 :: (MonadIO m) => T.Text -> -- utf8string Int64 -> -- len Word64 -> -- bytes_read Word64 -> -- bytes_written m T.Text localeFromUtf8 utf8string len bytes_read bytes_written = liftIO $ do utf8string' <- textToCString utf8string onException (do result <- propagateGError $ g_locale_from_utf8 utf8string' len bytes_read bytes_written result' <- cstringToText result freeMem result freeMem utf8string' return result' ) (do freeMem utf8string' ) -- function g_locale_to_utf8 -- Args : [Arg {argName = "opsysstring", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "opsysstring", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, 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},Arg {argName = "bytes_written", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_locale_to_utf8" g_locale_to_utf8 :: CString -> -- opsysstring : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 Word64 -> -- bytes_read : TBasicType TUInt64 Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString localeToUtf8 :: (MonadIO m) => T.Text -> -- opsysstring Int64 -> -- len Word64 -> -- bytes_read Word64 -> -- bytes_written m T.Text localeToUtf8 opsysstring len bytes_read bytes_written = liftIO $ do opsysstring' <- textToCString opsysstring onException (do result <- propagateGError $ g_locale_to_utf8 opsysstring' len bytes_read bytes_written result' <- cstringToText result freeMem result freeMem opsysstring' return result' ) (do freeMem opsysstring' ) -- function g_log_default_handler -- Args : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "log_level", argType = TInterface "GLib" "LogLevelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "unused_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "log_level", argType = TInterface "GLib" "LogLevelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "unused_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_log_default_handler" g_log_default_handler :: CString -> -- log_domain : TBasicType TUTF8 CUInt -> -- log_level : TInterface "GLib" "LogLevelFlags" CString -> -- message : TBasicType TUTF8 Ptr () -> -- unused_data : TBasicType TVoid IO () logDefaultHandler :: (MonadIO m) => T.Text -> -- log_domain [LogLevelFlags] -> -- log_level T.Text -> -- message Ptr () -> -- unused_data m () logDefaultHandler log_domain log_level message unused_data = liftIO $ do log_domain' <- textToCString log_domain let log_level' = gflagsToWord log_level message' <- textToCString message g_log_default_handler log_domain' log_level' message' unused_data freeMem log_domain' freeMem message' return () -- function g_log_remove_handler -- Args : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_log_remove_handler" g_log_remove_handler :: CString -> -- log_domain : TBasicType TUTF8 Word32 -> -- handler_id : TBasicType TUInt32 IO () logRemoveHandler :: (MonadIO m) => T.Text -> -- log_domain Word32 -> -- handler_id m () logRemoveHandler log_domain handler_id = liftIO $ do log_domain' <- textToCString log_domain g_log_remove_handler log_domain' handler_id freeMem log_domain' return () -- function g_log_set_always_fatal -- Args : [Arg {argName = "fatal_mask", argType = TInterface "GLib" "LogLevelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "fatal_mask", argType = TInterface "GLib" "LogLevelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "LogLevelFlags" -- throws : False -- Skip return : False foreign import ccall "g_log_set_always_fatal" g_log_set_always_fatal :: CUInt -> -- fatal_mask : TInterface "GLib" "LogLevelFlags" IO CUInt logSetAlwaysFatal :: (MonadIO m) => [LogLevelFlags] -> -- fatal_mask m [LogLevelFlags] logSetAlwaysFatal fatal_mask = liftIO $ do let fatal_mask' = gflagsToWord fatal_mask result <- g_log_set_always_fatal fatal_mask' let result' = wordToGFlags result return result' -- function g_log_set_fatal_mask -- Args : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fatal_mask", argType = TInterface "GLib" "LogLevelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fatal_mask", argType = TInterface "GLib" "LogLevelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "LogLevelFlags" -- throws : False -- Skip return : False foreign import ccall "g_log_set_fatal_mask" g_log_set_fatal_mask :: CString -> -- log_domain : TBasicType TUTF8 CUInt -> -- fatal_mask : TInterface "GLib" "LogLevelFlags" IO CUInt logSetFatalMask :: (MonadIO m) => T.Text -> -- log_domain [LogLevelFlags] -> -- fatal_mask m [LogLevelFlags] logSetFatalMask log_domain fatal_mask = liftIO $ do log_domain' <- textToCString log_domain let fatal_mask' = gflagsToWord fatal_mask result <- g_log_set_fatal_mask log_domain' fatal_mask' let result' = wordToGFlags result freeMem log_domain' return result' -- function g_main_context_default -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "MainContext" -- throws : False -- Skip return : False foreign import ccall "g_main_context_default" g_main_context_default :: IO (Ptr MainContext) mainContextDefault :: (MonadIO m) => m MainContext mainContextDefault = liftIO $ do result <- g_main_context_default result' <- (newBoxed MainContext) result return result' -- function g_main_context_get_thread_default -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "MainContext" -- throws : False -- Skip return : False foreign import ccall "g_main_context_get_thread_default" g_main_context_get_thread_default :: IO (Ptr MainContext) mainContextGetThreadDefault :: (MonadIO m) => m MainContext mainContextGetThreadDefault = liftIO $ do result <- g_main_context_get_thread_default result' <- (newBoxed MainContext) result return result' -- function g_main_context_ref_thread_default -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "MainContext" -- throws : False -- Skip return : False foreign import ccall "g_main_context_ref_thread_default" g_main_context_ref_thread_default :: IO (Ptr MainContext) mainContextRefThreadDefault :: (MonadIO m) => m MainContext mainContextRefThreadDefault = liftIO $ do result <- g_main_context_ref_thread_default result' <- (wrapBoxed MainContext) result return result' -- function g_main_current_source -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_main_current_source" g_main_current_source :: IO (Ptr Source) mainCurrentSource :: (MonadIO m) => m Source mainCurrentSource = liftIO $ do result <- g_main_current_source result' <- (newBoxed Source) result return result' -- function g_main_depth -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_main_depth" g_main_depth :: IO Int32 mainDepth :: (MonadIO m) => m Int32 mainDepth = liftIO $ do result <- g_main_depth return result -- function g_markup_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_markup_error_quark" g_markup_error_quark :: IO Word32 markupErrorQuark :: (MonadIO m) => m Word32 markupErrorQuark = liftIO $ do result <- g_markup_error_quark return result -- function g_markup_escape_text -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_markup_escape_text" g_markup_escape_text :: CString -> -- text : TBasicType TUTF8 Int64 -> -- length : TBasicType TInt64 IO CString markupEscapeText :: (MonadIO m) => T.Text -> -- text Int64 -> -- length m T.Text markupEscapeText text length_ = liftIO $ do text' <- textToCString text result <- g_markup_escape_text text' length_ result' <- cstringToText result freeMem result freeMem text' return result' -- function g_mem_is_system_malloc -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_mem_is_system_malloc" g_mem_is_system_malloc :: IO CInt memIsSystemMalloc :: (MonadIO m) => m Bool memIsSystemMalloc = liftIO $ do result <- g_mem_is_system_malloc let result' = (/= 0) result return result' -- function g_mem_profile -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mem_profile" g_mem_profile :: IO () memProfile :: (MonadIO m) => m () memProfile = liftIO $ do g_mem_profile return () -- function g_mem_set_vtable -- Args : [Arg {argName = "vtable", argType = TInterface "GLib" "MemVTable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "vtable", argType = TInterface "GLib" "MemVTable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mem_set_vtable" g_mem_set_vtable :: Ptr MemVTable -> -- vtable : TInterface "GLib" "MemVTable" IO () memSetVtable :: (MonadIO m) => MemVTable -> -- vtable m () memSetVtable vtable = liftIO $ do let vtable' = unsafeManagedPtrGetPtr vtable g_mem_set_vtable vtable' touchManagedPtr vtable return () -- function g_mkdir_with_parents -- Args : [Arg {argName = "pathname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pathname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_mkdir_with_parents" g_mkdir_with_parents :: CString -> -- pathname : TBasicType TUTF8 Int32 -> -- mode : TBasicType TInt32 IO Int32 mkdirWithParents :: (MonadIO m) => T.Text -> -- pathname Int32 -> -- mode m Int32 mkdirWithParents pathname mode = liftIO $ do pathname' <- textToCString pathname result <- g_mkdir_with_parents pathname' mode freeMem pathname' return result -- function g_mkdtemp -- Args : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_mkdtemp" g_mkdtemp :: CString -> -- tmpl : TBasicType TFileName IO CString mkdtemp :: (MonadIO m) => [Char] -> -- tmpl m T.Text mkdtemp tmpl = liftIO $ do tmpl' <- stringToCString tmpl result <- g_mkdtemp tmpl' result' <- cstringToText result freeMem result freeMem tmpl' return result' -- function g_mkdtemp_full -- Args : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", 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_mkdtemp_full" g_mkdtemp_full :: CString -> -- tmpl : TBasicType TFileName Int32 -> -- mode : TBasicType TInt32 IO CString mkdtempFull :: (MonadIO m) => [Char] -> -- tmpl Int32 -> -- mode m T.Text mkdtempFull tmpl mode = liftIO $ do tmpl' <- stringToCString tmpl result <- g_mkdtemp_full tmpl' mode result' <- cstringToText result freeMem result freeMem tmpl' return result' -- function g_mkstemp -- Args : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_mkstemp" g_mkstemp :: CString -> -- tmpl : TBasicType TFileName IO Int32 mkstemp :: (MonadIO m) => [Char] -> -- tmpl m Int32 mkstemp tmpl = liftIO $ do tmpl' <- stringToCString tmpl result <- g_mkstemp tmpl' freeMem tmpl' return result -- function g_mkstemp_full -- Args : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_mkstemp_full" g_mkstemp_full :: CString -> -- tmpl : TBasicType TFileName Int32 -> -- flags : TBasicType TInt32 Int32 -> -- mode : TBasicType TInt32 IO Int32 mkstempFull :: (MonadIO m) => [Char] -> -- tmpl Int32 -> -- flags Int32 -> -- mode m Int32 mkstempFull tmpl flags mode = liftIO $ do tmpl' <- stringToCString tmpl result <- g_mkstemp_full tmpl' flags mode freeMem tmpl' return result -- function g_nullify_pointer -- Args : [Arg {argName = "nullify_location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "nullify_location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_nullify_pointer" g_nullify_pointer :: Ptr () -> -- nullify_location : TBasicType TVoid IO () nullifyPointer :: (MonadIO m) => Ptr () -> -- nullify_location m () nullifyPointer nullify_location = liftIO $ do g_nullify_pointer nullify_location return () -- function g_on_error_query -- Args : [Arg {argName = "prg_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "prg_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_on_error_query" g_on_error_query :: CString -> -- prg_name : TBasicType TUTF8 IO () onErrorQuery :: (MonadIO m) => T.Text -> -- prg_name m () onErrorQuery prg_name = liftIO $ do prg_name' <- textToCString prg_name g_on_error_query prg_name' freeMem prg_name' return () -- function g_on_error_stack_trace -- Args : [Arg {argName = "prg_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "prg_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_on_error_stack_trace" g_on_error_stack_trace :: CString -> -- prg_name : TBasicType TUTF8 IO () onErrorStackTrace :: (MonadIO m) => T.Text -> -- prg_name m () onErrorStackTrace prg_name = liftIO $ do prg_name' <- textToCString prg_name g_on_error_stack_trace prg_name' freeMem prg_name' return () -- function g_once_init_enter -- Args : [Arg {argName = "location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_once_init_enter" g_once_init_enter :: Ptr () -> -- location : TBasicType TVoid IO CInt onceInitEnter :: (MonadIO m) => Ptr () -> -- location m Bool onceInitEnter location = liftIO $ do result <- g_once_init_enter location let result' = (/= 0) result return result' -- function g_once_init_leave -- Args : [Arg {argName = "location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "location", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", 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_once_init_leave" g_once_init_leave :: Ptr () -> -- location : TBasicType TVoid Word64 -> -- result : TBasicType TUInt64 IO () onceInitLeave :: (MonadIO m) => Ptr () -> -- location Word64 -> -- result m () onceInitLeave location result_ = liftIO $ do g_once_init_leave location result_ return () -- function g_option_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_option_error_quark" g_option_error_quark :: IO Word32 optionErrorQuark :: (MonadIO m) => m Word32 optionErrorQuark = liftIO $ do result <- g_option_error_quark return result -- function g_parse_debug_string -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keys", argType = TCArray False (-1) 2 (TInterface "GLib" "DebugKey"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nkeys", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "nkeys", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keys", argType = TCArray False (-1) 2 (TInterface "GLib" "DebugKey"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_parse_debug_string" g_parse_debug_string :: CString -> -- string : TBasicType TUTF8 Ptr DebugKey -> -- keys : TCArray False (-1) 2 (TInterface "GLib" "DebugKey") Word32 -> -- nkeys : TBasicType TUInt32 IO Word32 parseDebugString :: (MonadIO m) => Maybe (T.Text) -> -- string [DebugKey] -> -- keys m Word32 parseDebugString string keys = liftIO $ do let nkeys = fromIntegral $ length keys maybeString <- case string of Nothing -> return nullPtr Just jString -> do jString' <- textToCString jString return jString' let keys' = map unsafeManagedPtrGetPtr keys keys'' <- packBlockArray 16 keys' result <- g_parse_debug_string maybeString keys'' nkeys mapM_ touchManagedPtr keys freeMem maybeString freeMem keys'' return result -- function g_path_get_basename -- Args : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_path_get_basename" g_path_get_basename :: CString -> -- file_name : TBasicType TUTF8 IO CString pathGetBasename :: (MonadIO m) => T.Text -> -- file_name m T.Text pathGetBasename file_name = liftIO $ do file_name' <- textToCString file_name result <- g_path_get_basename file_name' result' <- cstringToText result freeMem result freeMem file_name' return result' -- function g_path_get_dirname -- Args : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_path_get_dirname" g_path_get_dirname :: CString -> -- file_name : TBasicType TUTF8 IO CString pathGetDirname :: (MonadIO m) => T.Text -> -- file_name m T.Text pathGetDirname file_name = liftIO $ do file_name' <- textToCString file_name result <- g_path_get_dirname file_name' result' <- cstringToText result freeMem result freeMem file_name' return result' -- function g_path_is_absolute -- Args : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_path_is_absolute" g_path_is_absolute :: CString -> -- file_name : TBasicType TUTF8 IO CInt pathIsAbsolute :: (MonadIO m) => T.Text -> -- file_name m Bool pathIsAbsolute file_name = liftIO $ do file_name' <- textToCString file_name result <- g_path_is_absolute file_name' let result' = (/= 0) result freeMem file_name' return result' -- function g_path_skip_root -- Args : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_path_skip_root" g_path_skip_root :: CString -> -- file_name : TBasicType TUTF8 IO CString pathSkipRoot :: (MonadIO m) => T.Text -> -- file_name m T.Text pathSkipRoot file_name = liftIO $ do file_name' <- textToCString file_name result <- g_path_skip_root file_name' result' <- cstringToText result freeMem file_name' return result' -- function g_pattern_match -- Args : [Arg {argName = "pspec", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_length", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_reversed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pspec", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_length", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_reversed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pattern_match" g_pattern_match :: Ptr PatternSpec -> -- pspec : TInterface "GLib" "PatternSpec" Word32 -> -- string_length : TBasicType TUInt32 CString -> -- string : TBasicType TUTF8 CString -> -- string_reversed : TBasicType TUTF8 IO CInt patternMatch :: (MonadIO m) => PatternSpec -> -- pspec Word32 -> -- string_length T.Text -> -- string Maybe (T.Text) -> -- string_reversed m Bool patternMatch pspec string_length string string_reversed = liftIO $ do let pspec' = unsafeManagedPtrGetPtr pspec string' <- textToCString string maybeString_reversed <- case string_reversed of Nothing -> return nullPtr Just jString_reversed -> do jString_reversed' <- textToCString jString_reversed return jString_reversed' result <- g_pattern_match pspec' string_length string' maybeString_reversed let result' = (/= 0) result touchManagedPtr pspec freeMem string' freeMem maybeString_reversed return result' -- function g_pattern_match_simple -- Args : [Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pattern_match_simple" g_pattern_match_simple :: CString -> -- pattern : TBasicType TUTF8 CString -> -- string : TBasicType TUTF8 IO CInt patternMatchSimple :: (MonadIO m) => T.Text -> -- pattern T.Text -> -- string m Bool patternMatchSimple pattern string = liftIO $ do pattern' <- textToCString pattern string' <- textToCString string result <- g_pattern_match_simple pattern' string' let result' = (/= 0) result freeMem pattern' freeMem string' return result' -- function g_pattern_match_string -- Args : [Arg {argName = "pspec", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pspec", argType = TInterface "GLib" "PatternSpec", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pattern_match_string" g_pattern_match_string :: Ptr PatternSpec -> -- pspec : TInterface "GLib" "PatternSpec" CString -> -- string : TBasicType TUTF8 IO CInt patternMatchString :: (MonadIO m) => PatternSpec -> -- pspec T.Text -> -- string m Bool patternMatchString pspec string = liftIO $ do let pspec' = unsafeManagedPtrGetPtr pspec string' <- textToCString string result <- g_pattern_match_string pspec' string' let result' = (/= 0) result touchManagedPtr pspec freeMem string' return result' -- function g_pointer_bit_lock -- Args : [Arg {argName = "address", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", 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_pointer_bit_lock" g_pointer_bit_lock :: Ptr () -> -- address : TBasicType TVoid Int32 -> -- lock_bit : TBasicType TInt32 IO () pointerBitLock :: (MonadIO m) => Ptr () -> -- address Int32 -> -- lock_bit m () pointerBitLock address lock_bit = liftIO $ do g_pointer_bit_lock address lock_bit return () -- function g_pointer_bit_trylock -- Args : [Arg {argName = "address", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pointer_bit_trylock" g_pointer_bit_trylock :: Ptr () -> -- address : TBasicType TVoid Int32 -> -- lock_bit : TBasicType TInt32 IO CInt pointerBitTrylock :: (MonadIO m) => Ptr () -> -- address Int32 -> -- lock_bit m Bool pointerBitTrylock address lock_bit = liftIO $ do result <- g_pointer_bit_trylock address lock_bit let result' = (/= 0) result return result' -- function g_pointer_bit_unlock -- Args : [Arg {argName = "address", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lock_bit", 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_pointer_bit_unlock" g_pointer_bit_unlock :: Ptr () -> -- address : TBasicType TVoid Int32 -> -- lock_bit : TBasicType TInt32 IO () pointerBitUnlock :: (MonadIO m) => Ptr () -> -- address Int32 -> -- lock_bit m () pointerBitUnlock address lock_bit = liftIO $ do g_pointer_bit_unlock address lock_bit return () -- function g_poll -- Args : [Arg {argName = "fds", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nfds", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "fds", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nfds", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_poll" g_poll :: Ptr PollFD -> -- fds : TInterface "GLib" "PollFD" Word32 -> -- nfds : TBasicType TUInt32 Int32 -> -- timeout : TBasicType TInt32 IO Int32 poll :: (MonadIO m) => PollFD -> -- fds Word32 -> -- nfds Int32 -> -- timeout m Int32 poll fds nfds timeout = liftIO $ do let fds' = unsafeManagedPtrGetPtr fds result <- g_poll fds' nfds timeout touchManagedPtr fds return result -- function g_propagate_error -- Args : [Arg {argName = "dest", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dest", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_propagate_error" g_propagate_error :: Ptr GError -> -- dest : TError Ptr GError -> -- src : TError IO () propagateError :: (MonadIO m) => GError -> -- dest GError -> -- src m () propagateError dest src = liftIO $ do let dest' = unsafeManagedPtrGetPtr dest let src' = unsafeManagedPtrGetPtr src g_propagate_error dest' src' touchManagedPtr dest touchManagedPtr src return () -- function g_quark_from_static_string -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_quark_from_static_string" g_quark_from_static_string :: CString -> -- string : TBasicType TUTF8 IO Word32 quarkFromStaticString :: (MonadIO m) => Maybe (T.Text) -> -- string m Word32 quarkFromStaticString string = liftIO $ do maybeString <- case string of Nothing -> return nullPtr Just jString -> do jString' <- textToCString jString return jString' result <- g_quark_from_static_string maybeString freeMem maybeString return result -- function g_quark_from_string -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_quark_from_string" g_quark_from_string :: CString -> -- string : TBasicType TUTF8 IO Word32 quarkFromString :: (MonadIO m) => Maybe (T.Text) -> -- string m Word32 quarkFromString string = liftIO $ do maybeString <- case string of Nothing -> return nullPtr Just jString -> do jString' <- textToCString jString return jString' result <- g_quark_from_string maybeString freeMem maybeString return result -- function g_quark_to_string -- Args : [Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_quark_to_string" g_quark_to_string :: Word32 -> -- quark : TBasicType TUInt32 IO CString quarkToString :: (MonadIO m) => Word32 -> -- quark m T.Text quarkToString quark = liftIO $ do result <- g_quark_to_string quark result' <- cstringToText result return result' -- function g_quark_try_string -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_quark_try_string" g_quark_try_string :: CString -> -- string : TBasicType TUTF8 IO Word32 quarkTryString :: (MonadIO m) => Maybe (T.Text) -> -- string m Word32 quarkTryString string = liftIO $ do maybeString <- case string of Nothing -> return nullPtr Just jString -> do jString' <- textToCString jString return jString' result <- g_quark_try_string maybeString freeMem maybeString return result -- function g_random_double -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_random_double" g_random_double :: IO CDouble randomDouble :: (MonadIO m) => m Double randomDouble = liftIO $ do result <- g_random_double let result' = realToFrac result return result' -- function g_random_double_range -- Args : [Arg {argName = "begin", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "begin", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_random_double_range" g_random_double_range :: CDouble -> -- begin : TBasicType TDouble CDouble -> -- end : TBasicType TDouble IO CDouble randomDoubleRange :: (MonadIO m) => Double -> -- begin Double -> -- end m Double randomDoubleRange begin end = liftIO $ do let begin' = realToFrac begin let end' = realToFrac end result <- g_random_double_range begin' end' let result' = realToFrac result return result' -- function g_random_int -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_random_int" g_random_int :: IO Word32 randomInt :: (MonadIO m) => m Word32 randomInt = liftIO $ do result <- g_random_int return result -- function g_random_int_range -- Args : [Arg {argName = "begin", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "begin", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_random_int_range" g_random_int_range :: Int32 -> -- begin : TBasicType TInt32 Int32 -> -- end : TBasicType TInt32 IO Int32 randomIntRange :: (MonadIO m) => Int32 -> -- begin Int32 -> -- end m Int32 randomIntRange begin end = liftIO $ do result <- g_random_int_range begin end return result -- function g_random_set_seed -- Args : [Arg {argName = "seed", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "seed", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_random_set_seed" g_random_set_seed :: Word32 -> -- seed : TBasicType TUInt32 IO () randomSetSeed :: (MonadIO m) => Word32 -> -- seed m () randomSetSeed seed = liftIO $ do g_random_set_seed seed return () -- function g_regex_check_replacement -- Args : [Arg {argName = "replacement", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "has_references", argType = TBasicType TBoolean, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "replacement", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_regex_check_replacement" g_regex_check_replacement :: CString -> -- replacement : TBasicType TUTF8 Ptr CInt -> -- has_references : TBasicType TBoolean Ptr (Ptr GError) -> -- error IO CInt regexCheckReplacement :: (MonadIO m) => T.Text -> -- replacement m (Bool) regexCheckReplacement replacement = liftIO $ do replacement' <- textToCString replacement has_references <- allocMem :: IO (Ptr CInt) onException (do _ <- propagateGError $ g_regex_check_replacement replacement' has_references has_references' <- peek has_references let has_references'' = (/= 0) has_references' freeMem replacement' freeMem has_references return has_references'' ) (do freeMem replacement' freeMem has_references ) -- function g_regex_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_regex_error_quark" g_regex_error_quark :: IO Word32 regexErrorQuark :: (MonadIO m) => m Word32 regexErrorQuark = liftIO $ do result <- g_regex_error_quark return result -- function g_regex_escape_nul -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, 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 = "string", argType = TBasicType TUTF8, 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_regex_escape_nul" g_regex_escape_nul :: CString -> -- string : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 IO CString regexEscapeNul :: (MonadIO m) => T.Text -> -- string Int32 -> -- length m T.Text regexEscapeNul string length_ = liftIO $ do string' <- textToCString string result <- g_regex_escape_nul string' length_ result' <- cstringToText result freeMem result freeMem string' return result' -- function g_regex_escape_string -- Args : [Arg {argName = "string", argType = TCArray False (-1) 1 (TBasicType TUTF8), 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 : [Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "string", argType = TCArray False (-1) 1 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_regex_escape_string" g_regex_escape_string :: Ptr CString -> -- string : TCArray False (-1) 1 (TBasicType TUTF8) Int32 -> -- length : TBasicType TInt32 IO CString regexEscapeString :: (MonadIO m) => [T.Text] -> -- string m T.Text regexEscapeString string = liftIO $ do let length_ = fromIntegral $ length string string' <- packUTF8CArray string result <- g_regex_escape_string string' length_ result' <- cstringToText result freeMem result (mapCArrayWithLength length_) freeMem string' freeMem string' return result' -- function g_regex_match_simple -- Args : [Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "compile_options", argType = TInterface "GLib" "RegexCompileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "compile_options", argType = TInterface "GLib" "RegexCompileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_regex_match_simple" g_regex_match_simple :: CString -> -- pattern : TBasicType TUTF8 CString -> -- string : TBasicType TUTF8 CUInt -> -- compile_options : TInterface "GLib" "RegexCompileFlags" CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" IO CInt regexMatchSimple :: (MonadIO m) => T.Text -> -- pattern T.Text -> -- string [RegexCompileFlags] -> -- compile_options [RegexMatchFlags] -> -- match_options m Bool regexMatchSimple pattern string compile_options match_options = liftIO $ do pattern' <- textToCString pattern string' <- textToCString string let compile_options' = gflagsToWord compile_options let match_options' = gflagsToWord match_options result <- g_regex_match_simple pattern' string' compile_options' match_options' let result' = (/= 0) result freeMem pattern' freeMem string' return result' -- function g_regex_split_simple -- Args : [Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "compile_options", argType = TInterface "GLib" "RegexCompileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "compile_options", argType = TInterface "GLib" "RegexCompileFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "match_options", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_regex_split_simple" g_regex_split_simple :: CString -> -- pattern : TBasicType TUTF8 CString -> -- string : TBasicType TUTF8 CUInt -> -- compile_options : TInterface "GLib" "RegexCompileFlags" CUInt -> -- match_options : TInterface "GLib" "RegexMatchFlags" IO (Ptr CString) regexSplitSimple :: (MonadIO m) => T.Text -> -- pattern T.Text -> -- string [RegexCompileFlags] -> -- compile_options [RegexMatchFlags] -> -- match_options m [T.Text] regexSplitSimple pattern string compile_options match_options = liftIO $ do pattern' <- textToCString pattern string' <- textToCString string let compile_options' = gflagsToWord compile_options let match_options' = gflagsToWord match_options result <- g_regex_split_simple pattern' string' compile_options' match_options' result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result freeMem pattern' freeMem string' return result' -- function g_reload_user_special_dirs_cache -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_reload_user_special_dirs_cache" g_reload_user_special_dirs_cache :: IO () reloadUserSpecialDirsCache :: (MonadIO m) => m () reloadUserSpecialDirsCache = liftIO $ do g_reload_user_special_dirs_cache return () -- function g_return_if_fail_warning -- Args : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pretty_function", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expression", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pretty_function", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "expression", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_return_if_fail_warning" g_return_if_fail_warning :: CString -> -- log_domain : TBasicType TUTF8 CString -> -- pretty_function : TBasicType TUTF8 CString -> -- expression : TBasicType TUTF8 IO () returnIfFailWarning :: (MonadIO m) => T.Text -> -- log_domain T.Text -> -- pretty_function T.Text -> -- expression m () returnIfFailWarning log_domain pretty_function expression = liftIO $ do log_domain' <- textToCString log_domain pretty_function' <- textToCString pretty_function expression' <- textToCString expression g_return_if_fail_warning log_domain' pretty_function' expression' freeMem log_domain' freeMem pretty_function' freeMem expression' return () -- function g_rmdir -- Args : [Arg {argName = "filename", 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}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_rmdir" g_rmdir :: CString -> -- filename : TBasicType TUTF8 IO Int32 rmdir :: (MonadIO m) => T.Text -> -- filename m Int32 rmdir filename = liftIO $ do filename' <- textToCString filename result <- g_rmdir filename' freeMem filename' return result -- function g_sequence_move -- Args : [Arg {argName = "src", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "src", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_sequence_move" g_sequence_move :: Ptr SequenceIter -> -- src : TInterface "GLib" "SequenceIter" Ptr SequenceIter -> -- dest : TInterface "GLib" "SequenceIter" IO () sequenceMove :: (MonadIO m) => SequenceIter -> -- src SequenceIter -> -- dest m () sequenceMove src dest = liftIO $ do let src' = unsafeManagedPtrGetPtr src let dest' = unsafeManagedPtrGetPtr dest g_sequence_move src' dest' touchManagedPtr src touchManagedPtr dest return () -- function g_sequence_move_range -- Args : [Arg {argName = "dest", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "begin", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dest", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "begin", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_sequence_move_range" g_sequence_move_range :: Ptr SequenceIter -> -- dest : TInterface "GLib" "SequenceIter" Ptr SequenceIter -> -- begin : TInterface "GLib" "SequenceIter" Ptr SequenceIter -> -- end : TInterface "GLib" "SequenceIter" IO () sequenceMoveRange :: (MonadIO m) => SequenceIter -> -- dest SequenceIter -> -- begin SequenceIter -> -- end m () sequenceMoveRange dest begin end = liftIO $ do let dest' = unsafeManagedPtrGetPtr dest let begin' = unsafeManagedPtrGetPtr begin let end' = unsafeManagedPtrGetPtr end g_sequence_move_range dest' begin' end' touchManagedPtr dest touchManagedPtr begin touchManagedPtr end return () -- function g_sequence_remove -- Args : [Arg {argName = "iter", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "iter", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_sequence_remove" g_sequence_remove :: Ptr SequenceIter -> -- iter : TInterface "GLib" "SequenceIter" IO () sequenceRemove :: (MonadIO m) => SequenceIter -> -- iter m () sequenceRemove iter = liftIO $ do let iter' = unsafeManagedPtrGetPtr iter g_sequence_remove iter' touchManagedPtr iter return () -- function g_sequence_remove_range -- Args : [Arg {argName = "begin", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "begin", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_sequence_remove_range" g_sequence_remove_range :: Ptr SequenceIter -> -- begin : TInterface "GLib" "SequenceIter" Ptr SequenceIter -> -- end : TInterface "GLib" "SequenceIter" IO () sequenceRemoveRange :: (MonadIO m) => SequenceIter -> -- begin SequenceIter -> -- end m () sequenceRemoveRange begin end = liftIO $ do let begin' = unsafeManagedPtrGetPtr begin let end' = unsafeManagedPtrGetPtr end g_sequence_remove_range begin' end' touchManagedPtr begin touchManagedPtr end return () -- function g_sequence_set -- Args : [Arg {argName = "iter", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "iter", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_sequence_set" g_sequence_set :: Ptr SequenceIter -> -- iter : TInterface "GLib" "SequenceIter" Ptr () -> -- data : TBasicType TVoid IO () sequenceSet :: (MonadIO m) => SequenceIter -> -- iter Ptr () -> -- data m () sequenceSet iter data_ = liftIO $ do let iter' = unsafeManagedPtrGetPtr iter g_sequence_set iter' data_ touchManagedPtr iter return () -- function g_sequence_swap -- Args : [Arg {argName = "a", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "b", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "a", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "b", argType = TInterface "GLib" "SequenceIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_sequence_swap" g_sequence_swap :: Ptr SequenceIter -> -- a : TInterface "GLib" "SequenceIter" Ptr SequenceIter -> -- b : TInterface "GLib" "SequenceIter" IO () sequenceSwap :: (MonadIO m) => SequenceIter -> -- a SequenceIter -> -- b m () sequenceSwap a b = liftIO $ do let a' = unsafeManagedPtrGetPtr a let b' = unsafeManagedPtrGetPtr b g_sequence_swap a' b' touchManagedPtr a touchManagedPtr b return () -- function g_set_application_name -- Args : [Arg {argName = "application_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "application_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_set_application_name" g_set_application_name :: CString -> -- application_name : TBasicType TUTF8 IO () setApplicationName :: (MonadIO m) => T.Text -> -- application_name m () setApplicationName application_name = liftIO $ do application_name' <- textToCString application_name g_set_application_name application_name' freeMem application_name' return () -- function g_set_error_literal -- Args : [Arg {argName = "err", argType = TError, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "domain", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "code", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "err", argType = TError, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "domain", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "code", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_set_error_literal" g_set_error_literal :: Ptr GError -> -- err : TError Word32 -> -- domain : TBasicType TUInt32 Int32 -> -- code : TBasicType TInt32 CString -> -- message : TBasicType TUTF8 IO () setErrorLiteral :: (MonadIO m) => Maybe (GError) -> -- err Word32 -> -- domain Int32 -> -- code T.Text -> -- message m () setErrorLiteral err domain code message = liftIO $ do maybeErr <- case err of Nothing -> return nullPtr Just jErr -> do let jErr' = unsafeManagedPtrGetPtr jErr return jErr' message' <- textToCString message g_set_error_literal maybeErr domain code message' whenJust err touchManagedPtr freeMem message' return () -- function g_set_prgname -- Args : [Arg {argName = "prgname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "prgname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_set_prgname" g_set_prgname :: CString -> -- prgname : TBasicType TUTF8 IO () setPrgname :: (MonadIO m) => T.Text -> -- prgname m () setPrgname prgname = liftIO $ do prgname' <- textToCString prgname g_set_prgname prgname' freeMem prgname' return () -- function g_setenv -- Args : [Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "overwrite", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "overwrite", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_setenv" g_setenv :: CString -> -- variable : TBasicType TUTF8 CString -> -- value : TBasicType TUTF8 CInt -> -- overwrite : TBasicType TBoolean IO CInt setenv :: (MonadIO m) => T.Text -> -- variable T.Text -> -- value Bool -> -- overwrite m Bool setenv variable value overwrite = liftIO $ do variable' <- textToCString variable value' <- textToCString value let overwrite' = (fromIntegral . fromEnum) overwrite result <- g_setenv variable' value' overwrite' let result' = (/= 0) result freeMem variable' freeMem value' return result' -- function g_shell_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_shell_error_quark" g_shell_error_quark :: IO Word32 shellErrorQuark :: (MonadIO m) => m Word32 shellErrorQuark = liftIO $ do result <- g_shell_error_quark return result -- function g_shell_parse_argv -- Args : [Arg {argName = "command_line", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argcp", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "argvp", argType = TCArray True (-1) 1 (TBasicType TUTF8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "command_line", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_shell_parse_argv" g_shell_parse_argv :: CString -> -- command_line : TBasicType TUTF8 Ptr Int32 -> -- argcp : TBasicType TInt32 Ptr (Ptr CString) -> -- argvp : TCArray True (-1) 1 (TBasicType TUTF8) Ptr (Ptr GError) -> -- error IO CInt shellParseArgv :: (MonadIO m) => T.Text -> -- command_line m (Int32,[T.Text]) shellParseArgv command_line = liftIO $ do command_line' <- textToCString command_line argcp <- allocMem :: IO (Ptr Int32) argvp <- allocMem :: IO (Ptr (Ptr CString)) onException (do _ <- propagateGError $ g_shell_parse_argv command_line' argcp argvp argcp' <- peek argcp argvp' <- peek argvp argvp'' <- unpackZeroTerminatedUTF8CArray argvp' mapZeroTerminatedCArray freeMem argvp' freeMem argvp' freeMem command_line' freeMem argcp freeMem argvp return (argcp', argvp'') ) (do freeMem command_line' freeMem argcp freeMem argvp ) -- function g_shell_quote -- Args : [Arg {argName = "unquoted_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "unquoted_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_shell_quote" g_shell_quote :: CString -> -- unquoted_string : TBasicType TUTF8 IO CString shellQuote :: (MonadIO m) => T.Text -> -- unquoted_string m T.Text shellQuote unquoted_string = liftIO $ do unquoted_string' <- textToCString unquoted_string result <- g_shell_quote unquoted_string' result' <- cstringToText result freeMem result freeMem unquoted_string' return result' -- function g_shell_unquote -- Args : [Arg {argName = "quoted_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "quoted_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_shell_unquote" g_shell_unquote :: CString -> -- quoted_string : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CString shellUnquote :: (MonadIO m) => T.Text -> -- quoted_string m T.Text shellUnquote quoted_string = liftIO $ do quoted_string' <- textToCString quoted_string onException (do result <- propagateGError $ g_shell_unquote quoted_string' result' <- cstringToText result freeMem result freeMem quoted_string' return result' ) (do freeMem quoted_string' ) -- function g_slice_free1 -- Args : [Arg {argName = "block_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mem_block", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "block_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mem_block", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_slice_free1" g_slice_free1 :: Word64 -> -- block_size : TBasicType TUInt64 Ptr () -> -- mem_block : TBasicType TVoid IO () sliceFree1 :: (MonadIO m) => Word64 -> -- block_size Ptr () -> -- mem_block m () sliceFree1 block_size mem_block = liftIO $ do g_slice_free1 block_size mem_block return () -- function g_slice_free_chain_with_offset -- Args : [Arg {argName = "block_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mem_chain", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "next_offset", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "block_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mem_chain", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "next_offset", 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_slice_free_chain_with_offset" g_slice_free_chain_with_offset :: Word64 -> -- block_size : TBasicType TUInt64 Ptr () -> -- mem_chain : TBasicType TVoid Word64 -> -- next_offset : TBasicType TUInt64 IO () sliceFreeChainWithOffset :: (MonadIO m) => Word64 -> -- block_size Ptr () -> -- mem_chain Word64 -> -- next_offset m () sliceFreeChainWithOffset block_size mem_chain next_offset = liftIO $ do g_slice_free_chain_with_offset block_size mem_chain next_offset return () -- function g_slice_get_config -- Args : [Arg {argName = "ckey", argType = TInterface "GLib" "SliceConfig", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ckey", argType = TInterface "GLib" "SliceConfig", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_slice_get_config" g_slice_get_config :: CUInt -> -- ckey : TInterface "GLib" "SliceConfig" IO Int64 sliceGetConfig :: (MonadIO m) => SliceConfig -> -- ckey m Int64 sliceGetConfig ckey = liftIO $ do let ckey' = (fromIntegral . fromEnum) ckey result <- g_slice_get_config ckey' return result -- function g_slice_get_config_state -- Args : [Arg {argName = "ckey", argType = TInterface "GLib" "SliceConfig", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ckey", argType = TInterface "GLib" "SliceConfig", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_slice_get_config_state" g_slice_get_config_state :: CUInt -> -- ckey : TInterface "GLib" "SliceConfig" Int64 -> -- address : TBasicType TInt64 Word32 -> -- n_values : TBasicType TUInt32 IO Int64 sliceGetConfigState :: (MonadIO m) => SliceConfig -> -- ckey Int64 -> -- address Word32 -> -- n_values m Int64 sliceGetConfigState ckey address n_values = liftIO $ do let ckey' = (fromIntegral . fromEnum) ckey result <- g_slice_get_config_state ckey' address n_values return result -- function g_slice_set_config -- Args : [Arg {argName = "ckey", argType = TInterface "GLib" "SliceConfig", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ckey", argType = TInterface "GLib" "SliceConfig", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_slice_set_config" g_slice_set_config :: CUInt -> -- ckey : TInterface "GLib" "SliceConfig" Int64 -> -- value : TBasicType TInt64 IO () sliceSetConfig :: (MonadIO m) => SliceConfig -> -- ckey Int64 -> -- value m () sliceSetConfig ckey value = liftIO $ do let ckey' = (fromIntegral . fromEnum) ckey g_slice_set_config ckey' value return () -- function g_source_remove -- Args : [Arg {argName = "tag", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tag", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_source_remove" g_source_remove :: Word32 -> -- tag : TBasicType TUInt32 IO CInt sourceRemove :: (MonadIO m) => Word32 -> -- tag m Bool sourceRemove tag = liftIO $ do result <- g_source_remove tag let result' = (/= 0) result return result' -- function g_source_remove_by_funcs_user_data -- Args : [Arg {argName = "funcs", argType = TInterface "GLib" "SourceFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "funcs", argType = TInterface "GLib" "SourceFuncs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_source_remove_by_funcs_user_data" g_source_remove_by_funcs_user_data :: Ptr SourceFuncs -> -- funcs : TInterface "GLib" "SourceFuncs" Ptr () -> -- user_data : TBasicType TVoid IO CInt sourceRemoveByFuncsUserData :: (MonadIO m) => SourceFuncs -> -- funcs Ptr () -> -- user_data m Bool sourceRemoveByFuncsUserData funcs user_data = liftIO $ do let funcs' = unsafeManagedPtrGetPtr funcs result <- g_source_remove_by_funcs_user_data funcs' user_data let result' = (/= 0) result touchManagedPtr funcs return result' -- function g_source_remove_by_user_data -- Args : [Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_source_remove_by_user_data" g_source_remove_by_user_data :: Ptr () -> -- user_data : TBasicType TVoid IO CInt sourceRemoveByUserData :: (MonadIO m) => Ptr () -> -- user_data m Bool sourceRemoveByUserData user_data = liftIO $ do result <- g_source_remove_by_user_data user_data let result' = (/= 0) result return result' -- function g_source_set_name_by_id -- Args : [Arg {argName = "tag", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "tag", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_set_name_by_id" g_source_set_name_by_id :: Word32 -> -- tag : TBasicType TUInt32 CString -> -- name : TBasicType TUTF8 IO () sourceSetNameById :: (MonadIO m) => Word32 -> -- tag T.Text -> -- name m () sourceSetNameById tag name = liftIO $ do name' <- textToCString name g_source_set_name_by_id tag name' freeMem name' return () -- function g_spaced_primes_closest -- Args : [Arg {argName = "num", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "num", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_spaced_primes_closest" g_spaced_primes_closest :: Word32 -> -- num : TBasicType TUInt32 IO Word32 spacedPrimesClosest :: (MonadIO m) => Word32 -> -- num m Word32 spacedPrimesClosest num = liftIO $ do result <- g_spaced_primes_closest num return result -- function g_spawn_async -- Args : [Arg {argName = "working_directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "SpawnFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_pid", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "working_directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "SpawnFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_spawn_async" g_spawn_async :: CString -> -- working_directory : TBasicType TUTF8 Ptr CString -> -- argv : TCArray True (-1) (-1) (TBasicType TUTF8) Ptr CString -> -- envp : TCArray True (-1) (-1) (TBasicType TUTF8) CUInt -> -- flags : TInterface "GLib" "SpawnFlags" FunPtr SpawnChildSetupFuncC -> -- child_setup : TInterface "GLib" "SpawnChildSetupFunc" Ptr () -> -- user_data : TBasicType TVoid Ptr Int32 -> -- child_pid : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt spawnAsync :: (MonadIO m) => Maybe (T.Text) -> -- working_directory [T.Text] -> -- argv Maybe ([T.Text]) -> -- envp [SpawnFlags] -> -- flags Maybe (SpawnChildSetupFunc) -> -- child_setup m (Int32) spawnAsync working_directory argv envp flags child_setup = liftIO $ do maybeWorking_directory <- case working_directory of Nothing -> return nullPtr Just jWorking_directory -> do jWorking_directory' <- textToCString jWorking_directory return jWorking_directory' argv' <- packZeroTerminatedUTF8CArray argv maybeEnvp <- case envp of Nothing -> return nullPtr Just jEnvp -> do jEnvp' <- packZeroTerminatedUTF8CArray jEnvp return jEnvp' let flags' = gflagsToWord flags ptrchild_setup <- callocBytes $ sizeOf (undefined :: FunPtr SpawnChildSetupFuncC) maybeChild_setup <- case child_setup of Nothing -> return (castPtrToFunPtr nullPtr) Just jChild_setup -> do jChild_setup' <- mkSpawnChildSetupFunc (spawnChildSetupFuncWrapper (Just ptrchild_setup) jChild_setup) poke ptrchild_setup jChild_setup' return jChild_setup' child_pid <- allocMem :: IO (Ptr Int32) let user_data = nullPtr onException (do _ <- propagateGError $ g_spawn_async maybeWorking_directory argv' maybeEnvp flags' maybeChild_setup user_data child_pid child_pid' <- peek child_pid freeMem maybeWorking_directory mapZeroTerminatedCArray freeMem argv' freeMem argv' mapZeroTerminatedCArray freeMem maybeEnvp freeMem maybeEnvp freeMem child_pid return child_pid' ) (do freeMem maybeWorking_directory mapZeroTerminatedCArray freeMem argv' freeMem argv' mapZeroTerminatedCArray freeMem maybeEnvp freeMem maybeEnvp freeMem child_pid ) -- function g_spawn_async_with_pipes -- Args : [Arg {argName = "working_directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "SpawnFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_pid", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "standard_input", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "standard_output", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "standard_error", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "working_directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "SpawnFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_spawn_async_with_pipes" g_spawn_async_with_pipes :: CString -> -- working_directory : TBasicType TUTF8 Ptr CString -> -- argv : TCArray True (-1) (-1) (TBasicType TUTF8) Ptr CString -> -- envp : TCArray True (-1) (-1) (TBasicType TUTF8) CUInt -> -- flags : TInterface "GLib" "SpawnFlags" FunPtr SpawnChildSetupFuncC -> -- child_setup : TInterface "GLib" "SpawnChildSetupFunc" Ptr () -> -- user_data : TBasicType TVoid Ptr Int32 -> -- child_pid : TBasicType TInt32 Ptr Int32 -> -- standard_input : TBasicType TInt32 Ptr Int32 -> -- standard_output : TBasicType TInt32 Ptr Int32 -> -- standard_error : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt spawnAsyncWithPipes :: (MonadIO m) => Maybe (T.Text) -> -- working_directory [T.Text] -> -- argv Maybe ([T.Text]) -> -- envp [SpawnFlags] -> -- flags Maybe (SpawnChildSetupFunc) -> -- child_setup m (Int32,Int32,Int32,Int32) spawnAsyncWithPipes working_directory argv envp flags child_setup = liftIO $ do maybeWorking_directory <- case working_directory of Nothing -> return nullPtr Just jWorking_directory -> do jWorking_directory' <- textToCString jWorking_directory return jWorking_directory' argv' <- packZeroTerminatedUTF8CArray argv maybeEnvp <- case envp of Nothing -> return nullPtr Just jEnvp -> do jEnvp' <- packZeroTerminatedUTF8CArray jEnvp return jEnvp' let flags' = gflagsToWord flags ptrchild_setup <- callocBytes $ sizeOf (undefined :: FunPtr SpawnChildSetupFuncC) maybeChild_setup <- case child_setup of Nothing -> return (castPtrToFunPtr nullPtr) Just jChild_setup -> do jChild_setup' <- mkSpawnChildSetupFunc (spawnChildSetupFuncWrapper (Just ptrchild_setup) jChild_setup) poke ptrchild_setup jChild_setup' return jChild_setup' child_pid <- allocMem :: IO (Ptr Int32) standard_input <- allocMem :: IO (Ptr Int32) standard_output <- allocMem :: IO (Ptr Int32) standard_error <- allocMem :: IO (Ptr Int32) let user_data = nullPtr onException (do _ <- propagateGError $ g_spawn_async_with_pipes maybeWorking_directory argv' maybeEnvp flags' maybeChild_setup user_data child_pid standard_input standard_output standard_error child_pid' <- peek child_pid standard_input' <- peek standard_input standard_output' <- peek standard_output standard_error' <- peek standard_error freeMem maybeWorking_directory mapZeroTerminatedCArray freeMem argv' freeMem argv' mapZeroTerminatedCArray freeMem maybeEnvp freeMem maybeEnvp freeMem child_pid freeMem standard_input freeMem standard_output freeMem standard_error return (child_pid', standard_input', standard_output', standard_error') ) (do freeMem maybeWorking_directory mapZeroTerminatedCArray freeMem argv' freeMem argv' mapZeroTerminatedCArray freeMem maybeEnvp freeMem maybeEnvp freeMem child_pid freeMem standard_input freeMem standard_output freeMem standard_error ) -- function g_spawn_check_exit_status -- Args : [Arg {argName = "exit_status", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "exit_status", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_spawn_check_exit_status" g_spawn_check_exit_status :: Int32 -> -- exit_status : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt spawnCheckExitStatus :: (MonadIO m) => Int32 -> -- exit_status m () spawnCheckExitStatus exit_status = liftIO $ do onException (do _ <- propagateGError $ g_spawn_check_exit_status exit_status return () ) (do return () ) -- function g_spawn_close_pid -- Args : [Arg {argName = "pid", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pid", 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_spawn_close_pid" g_spawn_close_pid :: Int32 -> -- pid : TBasicType TInt32 IO () spawnClosePid :: (MonadIO m) => Int32 -> -- pid m () spawnClosePid pid = liftIO $ do g_spawn_close_pid pid return () -- function g_spawn_command_line_async -- Args : [Arg {argName = "command_line", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "command_line", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_spawn_command_line_async" g_spawn_command_line_async :: CString -> -- command_line : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt spawnCommandLineAsync :: (MonadIO m) => T.Text -> -- command_line m () spawnCommandLineAsync command_line = liftIO $ do command_line' <- textToCString command_line onException (do _ <- propagateGError $ g_spawn_command_line_async command_line' freeMem command_line' return () ) (do freeMem command_line' ) -- function g_spawn_command_line_sync -- Args : [Arg {argName = "command_line", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "standard_output", argType = TCArray True (-1) (-1) (TBasicType TUInt8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "standard_error", argType = TCArray True (-1) (-1) (TBasicType TUInt8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "exit_status", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "command_line", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_spawn_command_line_sync" g_spawn_command_line_sync :: CString -> -- command_line : TBasicType TUTF8 Ptr (Ptr Word8) -> -- standard_output : TCArray True (-1) (-1) (TBasicType TUInt8) Ptr (Ptr Word8) -> -- standard_error : TCArray True (-1) (-1) (TBasicType TUInt8) Ptr Int32 -> -- exit_status : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt spawnCommandLineSync :: (MonadIO m) => T.Text -> -- command_line m (ByteString,ByteString,Int32) spawnCommandLineSync command_line = liftIO $ do command_line' <- textToCString command_line standard_output <- allocMem :: IO (Ptr (Ptr Word8)) standard_error <- allocMem :: IO (Ptr (Ptr Word8)) exit_status <- allocMem :: IO (Ptr Int32) onException (do _ <- propagateGError $ g_spawn_command_line_sync command_line' standard_output standard_error exit_status standard_output' <- peek standard_output standard_output'' <- unpackZeroTerminatedByteString standard_output' freeMem standard_output' standard_error' <- peek standard_error standard_error'' <- unpackZeroTerminatedByteString standard_error' freeMem standard_error' exit_status' <- peek exit_status freeMem command_line' freeMem standard_output freeMem standard_error freeMem exit_status return (standard_output'', standard_error'', exit_status') ) (do freeMem command_line' freeMem standard_output freeMem standard_error freeMem exit_status ) -- function g_spawn_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_spawn_error_quark" g_spawn_error_quark :: IO Word32 spawnErrorQuark :: (MonadIO m) => m Word32 spawnErrorQuark = liftIO $ do result <- g_spawn_error_quark return result -- function g_spawn_exit_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_spawn_exit_error_quark" g_spawn_exit_error_quark :: IO Word32 spawnExitErrorQuark :: (MonadIO m) => m Word32 spawnExitErrorQuark = liftIO $ do result <- g_spawn_exit_error_quark return result -- function g_spawn_sync -- Args : [Arg {argName = "working_directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "SpawnFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "standard_output", argType = TCArray True (-1) (-1) (TBasicType TUInt8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "standard_error", argType = TCArray True (-1) (-1) (TBasicType TUInt8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "exit_status", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "working_directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "envp", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "SpawnFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_spawn_sync" g_spawn_sync :: CString -> -- working_directory : TBasicType TUTF8 Ptr CString -> -- argv : TCArray True (-1) (-1) (TBasicType TUTF8) Ptr CString -> -- envp : TCArray True (-1) (-1) (TBasicType TUTF8) CUInt -> -- flags : TInterface "GLib" "SpawnFlags" FunPtr SpawnChildSetupFuncC -> -- child_setup : TInterface "GLib" "SpawnChildSetupFunc" Ptr () -> -- user_data : TBasicType TVoid Ptr (Ptr Word8) -> -- standard_output : TCArray True (-1) (-1) (TBasicType TUInt8) Ptr (Ptr Word8) -> -- standard_error : TCArray True (-1) (-1) (TBasicType TUInt8) Ptr Int32 -> -- exit_status : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt spawnSync :: (MonadIO m) => Maybe (T.Text) -> -- working_directory [T.Text] -> -- argv Maybe ([T.Text]) -> -- envp [SpawnFlags] -> -- flags Maybe (SpawnChildSetupFunc) -> -- child_setup m (ByteString,ByteString,Int32) spawnSync working_directory argv envp flags child_setup = liftIO $ do maybeWorking_directory <- case working_directory of Nothing -> return nullPtr Just jWorking_directory -> do jWorking_directory' <- textToCString jWorking_directory return jWorking_directory' argv' <- packZeroTerminatedUTF8CArray argv maybeEnvp <- case envp of Nothing -> return nullPtr Just jEnvp -> do jEnvp' <- packZeroTerminatedUTF8CArray jEnvp return jEnvp' let flags' = gflagsToWord flags ptrchild_setup <- callocBytes $ sizeOf (undefined :: FunPtr SpawnChildSetupFuncC) maybeChild_setup <- case child_setup of Nothing -> return (castPtrToFunPtr nullPtr) Just jChild_setup -> do jChild_setup' <- mkSpawnChildSetupFunc (spawnChildSetupFuncWrapper (Just ptrchild_setup) jChild_setup) poke ptrchild_setup jChild_setup' return jChild_setup' standard_output <- allocMem :: IO (Ptr (Ptr Word8)) standard_error <- allocMem :: IO (Ptr (Ptr Word8)) exit_status <- allocMem :: IO (Ptr Int32) let user_data = nullPtr onException (do _ <- propagateGError $ g_spawn_sync maybeWorking_directory argv' maybeEnvp flags' maybeChild_setup user_data standard_output standard_error exit_status standard_output' <- peek standard_output standard_output'' <- unpackZeroTerminatedByteString standard_output' freeMem standard_output' standard_error' <- peek standard_error standard_error'' <- unpackZeroTerminatedByteString standard_error' freeMem standard_error' exit_status' <- peek exit_status freeMem maybeWorking_directory mapZeroTerminatedCArray freeMem argv' freeMem argv' mapZeroTerminatedCArray freeMem maybeEnvp freeMem maybeEnvp freeMem standard_output freeMem standard_error freeMem exit_status return (standard_output'', standard_error'', exit_status') ) (do freeMem maybeWorking_directory mapZeroTerminatedCArray freeMem argv' freeMem argv' mapZeroTerminatedCArray freeMem maybeEnvp freeMem maybeEnvp freeMem standard_output freeMem standard_error freeMem exit_status ) -- function g_stpcpy -- Args : [Arg {argName = "dest", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dest", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_stpcpy" g_stpcpy :: CString -> -- dest : TBasicType TUTF8 CString -> -- src : TBasicType TUTF8 IO CString stpcpy :: (MonadIO m) => T.Text -> -- dest T.Text -> -- src m T.Text stpcpy dest src = liftIO $ do dest' <- textToCString dest src' <- textToCString src result <- g_stpcpy dest' src' result' <- cstringToText result freeMem result freeMem dest' freeMem src' return result' -- function g_str_equal -- Args : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v1", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_str_equal" g_str_equal :: Ptr () -> -- v1 : TBasicType TVoid Ptr () -> -- v2 : TBasicType TVoid IO CInt strEqual :: (MonadIO m) => Ptr () -> -- v1 Ptr () -> -- v2 m Bool strEqual v1 v2 = liftIO $ do result <- g_str_equal v1 v2 let result' = (/= 0) result return result' -- function g_str_has_prefix -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "prefix", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "prefix", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_str_has_prefix" g_str_has_prefix :: CString -> -- str : TBasicType TUTF8 CString -> -- prefix : TBasicType TUTF8 IO CInt strHasPrefix :: (MonadIO m) => T.Text -> -- str T.Text -> -- prefix m Bool strHasPrefix str prefix = liftIO $ do str' <- textToCString str prefix' <- textToCString prefix result <- g_str_has_prefix str' prefix' let result' = (/= 0) result freeMem str' freeMem prefix' return result' -- function g_str_has_suffix -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "suffix", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "suffix", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_str_has_suffix" g_str_has_suffix :: CString -> -- str : TBasicType TUTF8 CString -> -- suffix : TBasicType TUTF8 IO CInt strHasSuffix :: (MonadIO m) => T.Text -> -- str T.Text -> -- suffix m Bool strHasSuffix str suffix = liftIO $ do str' <- textToCString str suffix' <- textToCString suffix result <- g_str_has_suffix str' suffix' let result' = (/= 0) result freeMem str' freeMem suffix' return result' -- function g_str_hash -- Args : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "v", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_str_hash" g_str_hash :: Ptr () -> -- v : TBasicType TVoid IO Word32 strHash :: (MonadIO m) => Ptr () -> -- v m Word32 strHash v = liftIO $ do result <- g_str_hash v return result -- function g_str_is_ascii -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_str_is_ascii" g_str_is_ascii :: CString -> -- str : TBasicType TUTF8 IO CInt strIsAscii :: (MonadIO m) => T.Text -> -- str m Bool strIsAscii str = liftIO $ do str' <- textToCString str result <- g_str_is_ascii str' let result' = (/= 0) result freeMem str' return result' -- function g_str_match_string -- Args : [Arg {argName = "search_term", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "potential_hit", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accept_alternates", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "search_term", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "potential_hit", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accept_alternates", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_str_match_string" g_str_match_string :: CString -> -- search_term : TBasicType TUTF8 CString -> -- potential_hit : TBasicType TUTF8 CInt -> -- accept_alternates : TBasicType TBoolean IO CInt strMatchString :: (MonadIO m) => T.Text -> -- search_term T.Text -> -- potential_hit Bool -> -- accept_alternates m Bool strMatchString search_term potential_hit accept_alternates = liftIO $ do search_term' <- textToCString search_term potential_hit' <- textToCString potential_hit let accept_alternates' = (fromIntegral . fromEnum) accept_alternates result <- g_str_match_string search_term' potential_hit' accept_alternates' let result' = (/= 0) result freeMem search_term' freeMem potential_hit' return result' -- function g_str_to_ascii -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "from_locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "from_locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_str_to_ascii" g_str_to_ascii :: CString -> -- str : TBasicType TUTF8 CString -> -- from_locale : TBasicType TUTF8 IO CString strToAscii :: (MonadIO m) => T.Text -> -- str Maybe (T.Text) -> -- from_locale m T.Text strToAscii str from_locale = liftIO $ do str' <- textToCString str maybeFrom_locale <- case from_locale of Nothing -> return nullPtr Just jFrom_locale -> do jFrom_locale' <- textToCString jFrom_locale return jFrom_locale' result <- g_str_to_ascii str' maybeFrom_locale result' <- cstringToText result freeMem result freeMem str' freeMem maybeFrom_locale return result' -- function g_str_tokenize_and_fold -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "translit_locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ascii_alternates", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "translit_locale", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_str_tokenize_and_fold" g_str_tokenize_and_fold :: CString -> -- string : TBasicType TUTF8 CString -> -- translit_locale : TBasicType TUTF8 Ptr (Ptr CString) -> -- ascii_alternates : TCArray True (-1) (-1) (TBasicType TUTF8) IO (Ptr CString) strTokenizeAndFold :: (MonadIO m) => T.Text -> -- string Maybe (T.Text) -> -- translit_locale m ([T.Text],[T.Text]) strTokenizeAndFold string translit_locale = liftIO $ do string' <- textToCString string maybeTranslit_locale <- case translit_locale of Nothing -> return nullPtr Just jTranslit_locale -> do jTranslit_locale' <- textToCString jTranslit_locale return jTranslit_locale' ascii_alternates <- allocMem :: IO (Ptr (Ptr CString)) result <- g_str_tokenize_and_fold string' maybeTranslit_locale ascii_alternates result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result ascii_alternates' <- peek ascii_alternates ascii_alternates'' <- unpackZeroTerminatedUTF8CArray ascii_alternates' mapZeroTerminatedCArray freeMem ascii_alternates' freeMem ascii_alternates' freeMem string' freeMem maybeTranslit_locale freeMem ascii_alternates return (result', ascii_alternates'') -- function g_strcanon -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "valid_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "substitutor", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "valid_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "substitutor", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strcanon" g_strcanon :: CString -> -- string : TBasicType TUTF8 CString -> -- valid_chars : TBasicType TUTF8 Int8 -> -- substitutor : TBasicType TInt8 IO CString strcanon :: (MonadIO m) => T.Text -> -- string T.Text -> -- valid_chars Int8 -> -- substitutor m T.Text strcanon string valid_chars substitutor = liftIO $ do string' <- textToCString string valid_chars' <- textToCString valid_chars result <- g_strcanon string' valid_chars' substitutor result' <- cstringToText result freeMem result freeMem string' freeMem valid_chars' return result' -- function g_strcasecmp -- Args : [Arg {argName = "s1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "s2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "s1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "s2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_strcasecmp" g_strcasecmp :: CString -> -- s1 : TBasicType TUTF8 CString -> -- s2 : TBasicType TUTF8 IO Int32 {-# DEPRECATED strcasecmp ["(Since version 2.2)","See g_strncasecmp() for a discussion of why this"," function is deprecated and how to replace it."]#-} strcasecmp :: (MonadIO m) => T.Text -> -- s1 T.Text -> -- s2 m Int32 strcasecmp s1 s2 = liftIO $ do s1' <- textToCString s1 s2' <- textToCString s2 result <- g_strcasecmp s1' s2' freeMem s1' freeMem s2' return result -- function g_strchomp -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strchomp" g_strchomp :: CString -> -- string : TBasicType TUTF8 IO CString strchomp :: (MonadIO m) => T.Text -> -- string m T.Text strchomp string = liftIO $ do string' <- textToCString string result <- g_strchomp string' result' <- cstringToText result freeMem result freeMem string' return result' -- function g_strchug -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strchug" g_strchug :: CString -> -- string : TBasicType TUTF8 IO CString strchug :: (MonadIO m) => T.Text -> -- string m T.Text strchug string = liftIO $ do string' <- textToCString string result <- g_strchug string' result' <- cstringToText result freeMem result freeMem string' return result' -- function g_strcmp0 -- Args : [Arg {argName = "str1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_strcmp0" g_strcmp0 :: CString -> -- str1 : TBasicType TUTF8 CString -> -- str2 : TBasicType TUTF8 IO Int32 strcmp0 :: (MonadIO m) => Maybe (T.Text) -> -- str1 Maybe (T.Text) -> -- str2 m Int32 strcmp0 str1 str2 = liftIO $ do maybeStr1 <- case str1 of Nothing -> return nullPtr Just jStr1 -> do jStr1' <- textToCString jStr1 return jStr1' maybeStr2 <- case str2 of Nothing -> return nullPtr Just jStr2 -> do jStr2' <- textToCString jStr2 return jStr2' result <- g_strcmp0 maybeStr1 maybeStr2 freeMem maybeStr1 freeMem maybeStr2 return result -- function g_strcompress -- Args : [Arg {argName = "source", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "source", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strcompress" g_strcompress :: CString -> -- source : TBasicType TUTF8 IO CString strcompress :: (MonadIO m) => T.Text -> -- source m T.Text strcompress source = liftIO $ do source' <- textToCString source result <- g_strcompress source' result' <- cstringToText result freeMem result freeMem source' return result' -- function g_strdelimit -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "delimiters", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_delimiter", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "delimiters", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_delimiter", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strdelimit" g_strdelimit :: CString -> -- string : TBasicType TUTF8 CString -> -- delimiters : TBasicType TUTF8 Int8 -> -- new_delimiter : TBasicType TInt8 IO CString strdelimit :: (MonadIO m) => T.Text -> -- string Maybe (T.Text) -> -- delimiters Int8 -> -- new_delimiter m T.Text strdelimit string delimiters new_delimiter = liftIO $ do string' <- textToCString string maybeDelimiters <- case delimiters of Nothing -> return nullPtr Just jDelimiters -> do jDelimiters' <- textToCString jDelimiters return jDelimiters' result <- g_strdelimit string' maybeDelimiters new_delimiter result' <- cstringToText result freeMem result freeMem string' freeMem maybeDelimiters return result' -- function g_strdown -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strdown" g_strdown :: CString -> -- string : TBasicType TUTF8 IO CString {-# DEPRECATED strdown ["(Since version 2.2)","This function is totally broken for the reasons discussed","in the g_strncasecmp() docs - use g_ascii_strdown() or g_utf8_strdown()","instead."]#-} strdown :: (MonadIO m) => T.Text -> -- string m T.Text strdown string = liftIO $ do string' <- textToCString string result <- g_strdown string' result' <- cstringToText result freeMem result freeMem string' return result' -- function g_strdup -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strdup" g_strdup :: CString -> -- str : TBasicType TUTF8 IO CString strdup :: (MonadIO m) => T.Text -> -- str m T.Text strdup str = liftIO $ do str' <- textToCString str result <- g_strdup str' result' <- cstringToText result freeMem result freeMem str' return result' -- function g_strerror -- Args : [Arg {argName = "errnum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "errnum", 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_strerror" g_strerror :: Int32 -> -- errnum : TBasicType TInt32 IO CString strerror :: (MonadIO m) => Int32 -> -- errnum m T.Text strerror errnum = liftIO $ do result <- g_strerror errnum result' <- cstringToText result return result' -- function g_strescape -- Args : [Arg {argName = "source", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exceptions", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "source", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exceptions", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strescape" g_strescape :: CString -> -- source : TBasicType TUTF8 CString -> -- exceptions : TBasicType TUTF8 IO CString strescape :: (MonadIO m) => T.Text -> -- source T.Text -> -- exceptions m T.Text strescape source exceptions = liftIO $ do source' <- textToCString source exceptions' <- textToCString exceptions result <- g_strescape source' exceptions' result' <- cstringToText result freeMem result freeMem source' freeMem exceptions' return result' -- function g_strfreev -- Args : [Arg {argName = "str_array", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str_array", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_strfreev" g_strfreev :: CString -> -- str_array : TBasicType TUTF8 IO () strfreev :: (MonadIO m) => T.Text -> -- str_array m () strfreev str_array = liftIO $ do str_array' <- textToCString str_array g_strfreev str_array' freeMem str_array' return () -- function g_string_new -- Args : [Arg {argName = "init", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "init", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_new" g_string_new :: CString -> -- init : TBasicType TUTF8 IO (Ptr String) stringNew :: (MonadIO m) => Maybe (T.Text) -> -- init m String stringNew init = liftIO $ do maybeInit <- case init of Nothing -> return nullPtr Just jInit -> do jInit' <- textToCString jInit return jInit' result <- g_string_new maybeInit result' <- (wrapBoxed String) result freeMem maybeInit return result' -- function g_string_new_len -- Args : [Arg {argName = "init", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "init", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_new_len" g_string_new_len :: CString -> -- init : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO (Ptr String) stringNewLen :: (MonadIO m) => T.Text -> -- init Int64 -> -- len m String stringNewLen init len = liftIO $ do init' <- textToCString init result <- g_string_new_len init' len result' <- (wrapBoxed String) result freeMem init' return result' -- function g_string_sized_new -- Args : [Arg {argName = "dfl_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dfl_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "String" -- throws : False -- Skip return : False foreign import ccall "g_string_sized_new" g_string_sized_new :: Word64 -> -- dfl_size : TBasicType TUInt64 IO (Ptr String) stringSizedNew :: (MonadIO m) => Word64 -> -- dfl_size m String stringSizedNew dfl_size = liftIO $ do result <- g_string_sized_new dfl_size result' <- (wrapBoxed String) result return result' -- function g_strip_context -- Args : [Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgval", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "msgid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "msgval", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strip_context" g_strip_context :: CString -> -- msgid : TBasicType TUTF8 CString -> -- msgval : TBasicType TUTF8 IO CString stripContext :: (MonadIO m) => T.Text -> -- msgid T.Text -> -- msgval m T.Text stripContext msgid msgval = liftIO $ do msgid' <- textToCString msgid msgval' <- textToCString msgval result <- g_strip_context msgid' msgval' result' <- cstringToText result freeMem msgid' freeMem msgval' return result' -- function g_strjoinv -- Args : [Arg {argName = "separator", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str_array", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "separator", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str_array", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strjoinv" g_strjoinv :: CString -> -- separator : TBasicType TUTF8 CString -> -- str_array : TBasicType TUTF8 IO CString strjoinv :: (MonadIO m) => Maybe (T.Text) -> -- separator T.Text -> -- str_array m T.Text strjoinv separator str_array = liftIO $ do maybeSeparator <- case separator of Nothing -> return nullPtr Just jSeparator -> do jSeparator' <- textToCString jSeparator return jSeparator' str_array' <- textToCString str_array result <- g_strjoinv maybeSeparator str_array' result' <- cstringToText result freeMem result freeMem maybeSeparator freeMem str_array' return result' -- function g_strlcat -- Args : [Arg {argName = "dest", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dest", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_strlcat" g_strlcat :: CString -> -- dest : TBasicType TUTF8 CString -> -- src : TBasicType TUTF8 Word64 -> -- dest_size : TBasicType TUInt64 IO Word64 strlcat :: (MonadIO m) => T.Text -> -- dest T.Text -> -- src Word64 -> -- dest_size m Word64 strlcat dest src dest_size = liftIO $ do dest' <- textToCString dest src' <- textToCString src result <- g_strlcat dest' src' dest_size freeMem dest' freeMem src' return result -- function g_strlcpy -- Args : [Arg {argName = "dest", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dest", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_strlcpy" g_strlcpy :: CString -> -- dest : TBasicType TUTF8 CString -> -- src : TBasicType TUTF8 Word64 -> -- dest_size : TBasicType TUInt64 IO Word64 strlcpy :: (MonadIO m) => T.Text -> -- dest T.Text -> -- src Word64 -> -- dest_size m Word64 strlcpy dest src dest_size = liftIO $ do dest' <- textToCString dest src' <- textToCString src result <- g_strlcpy dest' src' dest_size freeMem dest' freeMem src' return result -- function g_strncasecmp -- Args : [Arg {argName = "s1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "s2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "s1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "s2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_strncasecmp" g_strncasecmp :: CString -> -- s1 : TBasicType TUTF8 CString -> -- s2 : TBasicType TUTF8 Word32 -> -- n : TBasicType TUInt32 IO Int32 {-# DEPRECATED strncasecmp ["(Since version 2.2)","The problem with g_strncasecmp() is that it does"," the comparison by calling toupper()/tolower(). These functions"," are locale-specific and operate on single bytes. However, it is"," impossible to handle things correctly from an internationalization"," standpoint by operating on bytes, since characters may be multibyte."," Thus g_strncasecmp() is broken if your string is guaranteed to be"," ASCII, since it is locale-sensitive, and it's broken if your string"," is localized, since it doesn't work on many encodings at all,"," including UTF-8, EUC-JP, etc.",""," There are therefore two replacement techniques: g_ascii_strncasecmp(),"," which only works on ASCII and is not locale-sensitive, and"," g_utf8_casefold() followed by strcmp() on the resulting strings,"," which is good for case-insensitive sorting of UTF-8."]#-} strncasecmp :: (MonadIO m) => T.Text -> -- s1 T.Text -> -- s2 Word32 -> -- n m Int32 strncasecmp s1 s2 n = liftIO $ do s1' <- textToCString s1 s2' <- textToCString s2 result <- g_strncasecmp s1' s2' n freeMem s1' freeMem s2' return result -- function g_strndup -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strndup" g_strndup :: CString -> -- str : TBasicType TUTF8 Word64 -> -- n : TBasicType TUInt64 IO CString strndup :: (MonadIO m) => T.Text -> -- str Word64 -> -- n m T.Text strndup str n = liftIO $ do str' <- textToCString str result <- g_strndup str' n result' <- cstringToText result freeMem result freeMem str' return result' -- function g_strnfill -- Args : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fill_char", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fill_char", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strnfill" g_strnfill :: Word64 -> -- length : TBasicType TUInt64 Int8 -> -- fill_char : TBasicType TInt8 IO CString strnfill :: (MonadIO m) => Word64 -> -- length Int8 -> -- fill_char m T.Text strnfill length_ fill_char = liftIO $ do result <- g_strnfill length_ fill_char result' <- cstringToText result freeMem result return result' -- function g_strreverse -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strreverse" g_strreverse :: CString -> -- string : TBasicType TUTF8 IO CString strreverse :: (MonadIO m) => T.Text -> -- string m T.Text strreverse string = liftIO $ do string' <- textToCString string result <- g_strreverse string' result' <- cstringToText result freeMem result freeMem string' return result' -- function g_strrstr -- Args : [Arg {argName = "haystack", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "needle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "haystack", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "needle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strrstr" g_strrstr :: CString -> -- haystack : TBasicType TUTF8 CString -> -- needle : TBasicType TUTF8 IO CString strrstr :: (MonadIO m) => T.Text -> -- haystack T.Text -> -- needle m T.Text strrstr haystack needle = liftIO $ do haystack' <- textToCString haystack needle' <- textToCString needle result <- g_strrstr haystack' needle' result' <- cstringToText result freeMem result freeMem haystack' freeMem needle' return result' -- function g_strrstr_len -- Args : [Arg {argName = "haystack", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "haystack_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "needle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "haystack", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "haystack_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "needle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strrstr_len" g_strrstr_len :: CString -> -- haystack : TBasicType TUTF8 Int64 -> -- haystack_len : TBasicType TInt64 CString -> -- needle : TBasicType TUTF8 IO CString strrstrLen :: (MonadIO m) => T.Text -> -- haystack Int64 -> -- haystack_len T.Text -> -- needle m T.Text strrstrLen haystack haystack_len needle = liftIO $ do haystack' <- textToCString haystack needle' <- textToCString needle result <- g_strrstr_len haystack' haystack_len needle' result' <- cstringToText result freeMem result freeMem haystack' freeMem needle' return result' -- function g_strsignal -- Args : [Arg {argName = "signum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "signum", 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_strsignal" g_strsignal :: Int32 -> -- signum : TBasicType TInt32 IO CString strsignal :: (MonadIO m) => Int32 -> -- signum m T.Text strsignal signum = liftIO $ do result <- g_strsignal signum result' <- cstringToText result return result' -- function g_strstr_len -- Args : [Arg {argName = "haystack", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "haystack_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "needle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "haystack", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "haystack_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "needle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strstr_len" g_strstr_len :: CString -> -- haystack : TBasicType TUTF8 Int64 -> -- haystack_len : TBasicType TInt64 CString -> -- needle : TBasicType TUTF8 IO CString strstrLen :: (MonadIO m) => T.Text -> -- haystack Int64 -> -- haystack_len T.Text -> -- needle m T.Text strstrLen haystack haystack_len needle = liftIO $ do haystack' <- textToCString haystack needle' <- textToCString needle result <- g_strstr_len haystack' haystack_len needle' result' <- cstringToText result freeMem result freeMem haystack' freeMem needle' return result' -- function g_strtod -- Args : [Arg {argName = "nptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "nptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_strtod" g_strtod :: CString -> -- nptr : TBasicType TUTF8 CString -> -- endptr : TBasicType TUTF8 IO CDouble strtod :: (MonadIO m) => T.Text -> -- nptr T.Text -> -- endptr m Double strtod nptr endptr = liftIO $ do nptr' <- textToCString nptr endptr' <- textToCString endptr result <- g_strtod nptr' endptr' let result' = realToFrac result freeMem nptr' freeMem endptr' return result' -- function g_strup -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strup" g_strup :: CString -> -- string : TBasicType TUTF8 IO CString {-# DEPRECATED strup ["(Since version 2.2)","This function is totally broken for the reasons"," discussed in the g_strncasecmp() docs - use g_ascii_strup()"," or g_utf8_strup() instead."]#-} strup :: (MonadIO m) => T.Text -> -- string m T.Text strup string = liftIO $ do string' <- textToCString string result <- g_strup string' result' <- cstringToText result freeMem result freeMem string' return result' -- function g_strv_contains -- Args : [Arg {argName = "strv", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "strv", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_strv_contains" g_strv_contains :: CString -> -- strv : TBasicType TUTF8 CString -> -- str : TBasicType TUTF8 IO CInt strvContains :: (MonadIO m) => T.Text -> -- strv T.Text -> -- str m Bool strvContains strv str = liftIO $ do strv' <- textToCString strv str' <- textToCString str result <- g_strv_contains strv' str' let result' = (/= 0) result freeMem strv' freeMem str' return result' -- function g_strv_get_type -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_strv_get_type" g_strv_get_type :: IO CGType strvGetType :: (MonadIO m) => m GType strvGetType = liftIO $ do result <- g_strv_get_type let result' = GType result return result' -- function g_strv_length -- Args : [Arg {argName = "str_array", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str_array", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_strv_length" g_strv_length :: CString -> -- str_array : TBasicType TUTF8 IO Word32 strvLength :: (MonadIO m) => T.Text -> -- str_array m Word32 strvLength str_array = liftIO $ do str_array' <- textToCString str_array result <- g_strv_length str_array' freeMem str_array' return result -- function g_test_add_data_func -- Args : [Arg {argName = "testpath", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_func", argType = TInterface "GLib" "TestDataFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "testpath", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_func", argType = TInterface "GLib" "TestDataFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_add_data_func" g_test_add_data_func :: CString -> -- testpath : TBasicType TUTF8 Ptr () -> -- test_data : TBasicType TVoid FunPtr TestDataFuncC -> -- test_func : TInterface "GLib" "TestDataFunc" IO () testAddDataFunc :: (MonadIO m) => T.Text -> -- testpath Ptr () -> -- test_data TestDataFunc -> -- test_func m () testAddDataFunc testpath test_data test_func = liftIO $ do testpath' <- textToCString testpath ptrtest_func <- callocBytes $ sizeOf (undefined :: FunPtr TestDataFuncC) test_func' <- mkTestDataFunc (testDataFuncWrapper (Just ptrtest_func) test_func) poke ptrtest_func test_func' g_test_add_data_func testpath' test_data test_func' freeMem testpath' return () -- function g_test_add_func -- Args : [Arg {argName = "testpath", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_func", argType = TInterface "GLib" "TestFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "testpath", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_func", argType = TInterface "GLib" "TestFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_add_func" g_test_add_func :: CString -> -- testpath : TBasicType TUTF8 FunPtr TestFuncC -> -- test_func : TInterface "GLib" "TestFunc" IO () testAddFunc :: (MonadIO m) => T.Text -> -- testpath TestFunc -> -- test_func m () testAddFunc testpath test_func = liftIO $ do testpath' <- textToCString testpath ptrtest_func <- callocBytes $ sizeOf (undefined :: FunPtr TestFuncC) test_func' <- mkTestFunc (testFuncWrapper (Just ptrtest_func) test_func) poke ptrtest_func test_func' g_test_add_func testpath' test_func' freeMem testpath' return () -- function g_test_assert_expected_messages_internal -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_assert_expected_messages_internal" g_test_assert_expected_messages_internal :: CString -> -- domain : TBasicType TUTF8 CString -> -- file : TBasicType TUTF8 Int32 -> -- line : TBasicType TInt32 CString -> -- func : TBasicType TUTF8 IO () testAssertExpectedMessagesInternal :: (MonadIO m) => T.Text -> -- domain T.Text -> -- file Int32 -> -- line T.Text -> -- func m () testAssertExpectedMessagesInternal domain file line func = liftIO $ do domain' <- textToCString domain file' <- textToCString file func' <- textToCString func g_test_assert_expected_messages_internal domain' file' line func' freeMem domain' freeMem file' freeMem func' return () -- function g_test_bug -- Args : [Arg {argName = "bug_uri_snippet", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bug_uri_snippet", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_bug" g_test_bug :: CString -> -- bug_uri_snippet : TBasicType TUTF8 IO () testBug :: (MonadIO m) => T.Text -> -- bug_uri_snippet m () testBug bug_uri_snippet = liftIO $ do bug_uri_snippet' <- textToCString bug_uri_snippet g_test_bug bug_uri_snippet' freeMem bug_uri_snippet' return () -- function g_test_bug_base -- Args : [Arg {argName = "uri_pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "uri_pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_bug_base" g_test_bug_base :: CString -> -- uri_pattern : TBasicType TUTF8 IO () testBugBase :: (MonadIO m) => T.Text -> -- uri_pattern m () testBugBase uri_pattern = liftIO $ do uri_pattern' <- textToCString uri_pattern g_test_bug_base uri_pattern' freeMem uri_pattern' return () -- function g_test_expect_message -- Args : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "log_level", argType = TInterface "GLib" "LogLevelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "log_domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "log_level", argType = TInterface "GLib" "LogLevelFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_expect_message" g_test_expect_message :: CString -> -- log_domain : TBasicType TUTF8 CUInt -> -- log_level : TInterface "GLib" "LogLevelFlags" CString -> -- pattern : TBasicType TUTF8 IO () testExpectMessage :: (MonadIO m) => Maybe (T.Text) -> -- log_domain [LogLevelFlags] -> -- log_level T.Text -> -- pattern m () testExpectMessage log_domain log_level pattern = liftIO $ do maybeLog_domain <- case log_domain of Nothing -> return nullPtr Just jLog_domain -> do jLog_domain' <- textToCString jLog_domain return jLog_domain' let log_level' = gflagsToWord log_level pattern' <- textToCString pattern g_test_expect_message maybeLog_domain log_level' pattern' freeMem maybeLog_domain freeMem pattern' return () -- function g_test_fail -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_fail" g_test_fail :: IO () testFail :: (MonadIO m) => m () testFail = liftIO $ do g_test_fail return () -- function g_test_failed -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_test_failed" g_test_failed :: IO CInt testFailed :: (MonadIO m) => m Bool testFailed = liftIO $ do result <- g_test_failed let result' = (/= 0) result return result' -- function g_test_get_dir -- Args : [Arg {argName = "file_type", argType = TInterface "GLib" "TestFileType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file_type", argType = TInterface "GLib" "TestFileType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_test_get_dir" g_test_get_dir :: CUInt -> -- file_type : TInterface "GLib" "TestFileType" IO CString testGetDir :: (MonadIO m) => TestFileType -> -- file_type m T.Text testGetDir file_type = liftIO $ do let file_type' = (fromIntegral . fromEnum) file_type result <- g_test_get_dir file_type' result' <- cstringToText result return result' -- function g_test_incomplete -- Args : [Arg {argName = "msg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "msg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_incomplete" g_test_incomplete :: CString -> -- msg : TBasicType TUTF8 IO () testIncomplete :: (MonadIO m) => Maybe (T.Text) -> -- msg m () testIncomplete msg = liftIO $ do maybeMsg <- case msg of Nothing -> return nullPtr Just jMsg -> do jMsg' <- textToCString jMsg return jMsg' g_test_incomplete maybeMsg freeMem maybeMsg return () -- function g_test_log_type_name -- Args : [Arg {argName = "log_type", argType = TInterface "GLib" "TestLogType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "log_type", argType = TInterface "GLib" "TestLogType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_test_log_type_name" g_test_log_type_name :: CUInt -> -- log_type : TInterface "GLib" "TestLogType" IO CString testLogTypeName :: (MonadIO m) => TestLogType -> -- log_type m T.Text testLogTypeName log_type = liftIO $ do let log_type' = (fromIntegral . fromEnum) log_type result <- g_test_log_type_name log_type' result' <- cstringToText result return result' -- function g_test_queue_destroy -- Args : [Arg {argName = "destroy_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "destroy_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_queue_destroy" g_test_queue_destroy :: FunPtr DestroyNotifyC -> -- destroy_func : TInterface "GLib" "DestroyNotify" Ptr () -> -- destroy_data : TBasicType TVoid IO () testQueueDestroy :: (MonadIO m) => DestroyNotify -> -- destroy_func Ptr () -> -- destroy_data m () testQueueDestroy destroy_func destroy_data = liftIO $ do ptrdestroy_func <- callocBytes $ sizeOf (undefined :: FunPtr DestroyNotifyC) destroy_func' <- mkDestroyNotify (destroyNotifyWrapper (Just ptrdestroy_func) destroy_func) poke ptrdestroy_func destroy_func' g_test_queue_destroy destroy_func' destroy_data return () -- function g_test_queue_free -- Args : [Arg {argName = "gfree_pointer", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "gfree_pointer", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_queue_free" g_test_queue_free :: Ptr () -> -- gfree_pointer : TBasicType TVoid IO () testQueueFree :: (MonadIO m) => Ptr () -> -- gfree_pointer m () testQueueFree gfree_pointer = liftIO $ do g_test_queue_free gfree_pointer return () -- function g_test_rand_double -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_test_rand_double" g_test_rand_double :: IO CDouble testRandDouble :: (MonadIO m) => m Double testRandDouble = liftIO $ do result <- g_test_rand_double let result' = realToFrac result return result' -- function g_test_rand_double_range -- Args : [Arg {argName = "range_start", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "range_end", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "range_start", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "range_end", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_test_rand_double_range" g_test_rand_double_range :: CDouble -> -- range_start : TBasicType TDouble CDouble -> -- range_end : TBasicType TDouble IO CDouble testRandDoubleRange :: (MonadIO m) => Double -> -- range_start Double -> -- range_end m Double testRandDoubleRange range_start range_end = liftIO $ do let range_start' = realToFrac range_start let range_end' = realToFrac range_end result <- g_test_rand_double_range range_start' range_end' let result' = realToFrac result return result' -- function g_test_rand_int -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_test_rand_int" g_test_rand_int :: IO Int32 testRandInt :: (MonadIO m) => m Int32 testRandInt = liftIO $ do result <- g_test_rand_int return result -- function g_test_rand_int_range -- Args : [Arg {argName = "begin", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "begin", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_test_rand_int_range" g_test_rand_int_range :: Int32 -> -- begin : TBasicType TInt32 Int32 -> -- end : TBasicType TInt32 IO Int32 testRandIntRange :: (MonadIO m) => Int32 -> -- begin Int32 -> -- end m Int32 testRandIntRange begin end = liftIO $ do result <- g_test_rand_int_range begin end return result -- function g_test_run -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_test_run" g_test_run :: IO Int32 testRun :: (MonadIO m) => m Int32 testRun = liftIO $ do result <- g_test_run return result -- function g_test_run_suite -- Args : [Arg {argName = "suite", argType = TInterface "GLib" "TestSuite", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "suite", argType = TInterface "GLib" "TestSuite", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_test_run_suite" g_test_run_suite :: Ptr TestSuite -> -- suite : TInterface "GLib" "TestSuite" IO Int32 testRunSuite :: (MonadIO m) => TestSuite -> -- suite m Int32 testRunSuite suite = liftIO $ do let suite' = unsafeManagedPtrGetPtr suite result <- g_test_run_suite suite' touchManagedPtr suite return result -- function g_test_set_nonfatal_assertions -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_set_nonfatal_assertions" g_test_set_nonfatal_assertions :: IO () testSetNonfatalAssertions :: (MonadIO m) => m () testSetNonfatalAssertions = liftIO $ do g_test_set_nonfatal_assertions return () -- function g_test_skip -- Args : [Arg {argName = "msg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "msg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_skip" g_test_skip :: CString -> -- msg : TBasicType TUTF8 IO () testSkip :: (MonadIO m) => Maybe (T.Text) -> -- msg m () testSkip msg = liftIO $ do maybeMsg <- case msg of Nothing -> return nullPtr Just jMsg -> do jMsg' <- textToCString jMsg return jMsg' g_test_skip maybeMsg freeMem maybeMsg return () -- function g_test_subprocess -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_test_subprocess" g_test_subprocess :: IO CInt testSubprocess :: (MonadIO m) => m Bool testSubprocess = liftIO $ do result <- g_test_subprocess let result' = (/= 0) result return result' -- function g_test_timer_elapsed -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_test_timer_elapsed" g_test_timer_elapsed :: IO CDouble testTimerElapsed :: (MonadIO m) => m Double testTimerElapsed = liftIO $ do result <- g_test_timer_elapsed let result' = realToFrac result return result' -- function g_test_timer_last -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "g_test_timer_last" g_test_timer_last :: IO CDouble testTimerLast :: (MonadIO m) => m Double testTimerLast = liftIO $ do result <- g_test_timer_last let result' = realToFrac result return result' -- function g_test_timer_start -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_timer_start" g_test_timer_start :: IO () testTimerStart :: (MonadIO m) => m () testTimerStart = liftIO $ do g_test_timer_start return () -- function g_test_trap_assertions -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "assertion_flags", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "assertion_flags", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_trap_assertions" g_test_trap_assertions :: CString -> -- domain : TBasicType TUTF8 CString -> -- file : TBasicType TUTF8 Int32 -> -- line : TBasicType TInt32 CString -> -- func : TBasicType TUTF8 Word64 -> -- assertion_flags : TBasicType TUInt64 CString -> -- pattern : TBasicType TUTF8 IO () testTrapAssertions :: (MonadIO m) => T.Text -> -- domain T.Text -> -- file Int32 -> -- line T.Text -> -- func Word64 -> -- assertion_flags T.Text -> -- pattern m () testTrapAssertions domain file line func assertion_flags pattern = liftIO $ do domain' <- textToCString domain file' <- textToCString file func' <- textToCString func pattern' <- textToCString pattern g_test_trap_assertions domain' file' line func' assertion_flags pattern' freeMem domain' freeMem file' freeMem func' freeMem pattern' return () -- function g_test_trap_fork -- Args : [Arg {argName = "usec_timeout", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_trap_flags", argType = TInterface "GLib" "TestTrapFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "usec_timeout", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_trap_flags", argType = TInterface "GLib" "TestTrapFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_test_trap_fork" g_test_trap_fork :: Word64 -> -- usec_timeout : TBasicType TUInt64 CUInt -> -- test_trap_flags : TInterface "GLib" "TestTrapFlags" IO CInt {-# DEPRECATED testTrapFork ["This function is implemented only on Unix platforms,","and is not always reliable due to problems inherent in","fork-without-exec. Use g_test_trap_subprocess() instead."]#-} testTrapFork :: (MonadIO m) => Word64 -> -- usec_timeout [TestTrapFlags] -> -- test_trap_flags m Bool testTrapFork usec_timeout test_trap_flags = liftIO $ do let test_trap_flags' = gflagsToWord test_trap_flags result <- g_test_trap_fork usec_timeout test_trap_flags' let result' = (/= 0) result return result' -- function g_test_trap_has_passed -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_test_trap_has_passed" g_test_trap_has_passed :: IO CInt testTrapHasPassed :: (MonadIO m) => m Bool testTrapHasPassed = liftIO $ do result <- g_test_trap_has_passed let result' = (/= 0) result return result' -- function g_test_trap_reached_timeout -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_test_trap_reached_timeout" g_test_trap_reached_timeout :: IO CInt testTrapReachedTimeout :: (MonadIO m) => m Bool testTrapReachedTimeout = liftIO $ do result <- g_test_trap_reached_timeout let result' = (/= 0) result return result' -- function g_test_trap_subprocess -- Args : [Arg {argName = "test_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "usec_timeout", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_flags", argType = TInterface "GLib" "TestSubprocessFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "test_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "usec_timeout", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "test_flags", argType = TInterface "GLib" "TestSubprocessFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_trap_subprocess" g_test_trap_subprocess :: CString -> -- test_path : TBasicType TUTF8 Word64 -> -- usec_timeout : TBasicType TUInt64 CUInt -> -- test_flags : TInterface "GLib" "TestSubprocessFlags" IO () testTrapSubprocess :: (MonadIO m) => Maybe (T.Text) -> -- test_path Word64 -> -- usec_timeout [TestSubprocessFlags] -> -- test_flags m () testTrapSubprocess test_path usec_timeout test_flags = liftIO $ do maybeTest_path <- case test_path of Nothing -> return nullPtr Just jTest_path -> do jTest_path' <- textToCString jTest_path return jTest_path' let test_flags' = gflagsToWord test_flags g_test_trap_subprocess maybeTest_path usec_timeout test_flags' freeMem maybeTest_path return () -- function g_thread_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_thread_error_quark" g_thread_error_quark :: IO Word32 threadErrorQuark :: (MonadIO m) => m Word32 threadErrorQuark = liftIO $ do result <- g_thread_error_quark return result -- function g_thread_exit -- Args : [Arg {argName = "retval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "retval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_thread_exit" g_thread_exit :: Ptr () -> -- retval : TBasicType TVoid IO () threadExit :: (MonadIO m) => Ptr () -> -- retval m () threadExit retval = liftIO $ do g_thread_exit retval return () -- function g_thread_pool_get_max_idle_time -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_thread_pool_get_max_idle_time" g_thread_pool_get_max_idle_time :: IO Word32 threadPoolGetMaxIdleTime :: (MonadIO m) => m Word32 threadPoolGetMaxIdleTime = liftIO $ do result <- g_thread_pool_get_max_idle_time return result -- function g_thread_pool_get_max_unused_threads -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_thread_pool_get_max_unused_threads" g_thread_pool_get_max_unused_threads :: IO Int32 threadPoolGetMaxUnusedThreads :: (MonadIO m) => m Int32 threadPoolGetMaxUnusedThreads = liftIO $ do result <- g_thread_pool_get_max_unused_threads return result -- function g_thread_pool_get_num_unused_threads -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_thread_pool_get_num_unused_threads" g_thread_pool_get_num_unused_threads :: IO Word32 threadPoolGetNumUnusedThreads :: (MonadIO m) => m Word32 threadPoolGetNumUnusedThreads = liftIO $ do result <- g_thread_pool_get_num_unused_threads return result -- function g_thread_pool_set_max_idle_time -- Args : [Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_thread_pool_set_max_idle_time" g_thread_pool_set_max_idle_time :: Word32 -> -- interval : TBasicType TUInt32 IO () threadPoolSetMaxIdleTime :: (MonadIO m) => Word32 -> -- interval m () threadPoolSetMaxIdleTime interval = liftIO $ do g_thread_pool_set_max_idle_time interval return () -- function g_thread_pool_set_max_unused_threads -- Args : [Arg {argName = "max_threads", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "max_threads", 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_thread_pool_set_max_unused_threads" g_thread_pool_set_max_unused_threads :: Int32 -> -- max_threads : TBasicType TInt32 IO () threadPoolSetMaxUnusedThreads :: (MonadIO m) => Int32 -> -- max_threads m () threadPoolSetMaxUnusedThreads max_threads = liftIO $ do g_thread_pool_set_max_unused_threads max_threads return () -- function g_thread_pool_stop_unused_threads -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_thread_pool_stop_unused_threads" g_thread_pool_stop_unused_threads :: IO () threadPoolStopUnusedThreads :: (MonadIO m) => m () threadPoolStopUnusedThreads = liftIO $ do g_thread_pool_stop_unused_threads return () -- function g_thread_self -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "GLib" "Thread" -- throws : False -- Skip return : False foreign import ccall "g_thread_self" g_thread_self :: IO (Ptr Thread) threadSelf :: (MonadIO m) => m Thread threadSelf = liftIO $ do result <- g_thread_self result' <- (wrapBoxed Thread) result return result' -- function g_thread_yield -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_thread_yield" g_thread_yield :: IO () threadYield :: (MonadIO m) => m () threadYield = liftIO $ do g_thread_yield return () -- function g_time_val_from_iso8601 -- Args : [Arg {argName = "iso_date", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "time_", argType = TInterface "GLib" "TimeVal", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "iso_date", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_time_val_from_iso8601" g_time_val_from_iso8601 :: CString -> -- iso_date : TBasicType TUTF8 Ptr TimeVal -> -- time_ : TInterface "GLib" "TimeVal" IO CInt timeValFromIso8601 :: (MonadIO m) => T.Text -> -- iso_date m (Bool,TimeVal) timeValFromIso8601 iso_date = liftIO $ do iso_date' <- textToCString iso_date time_ <- callocBytes 16 :: IO (Ptr TimeVal) result <- g_time_val_from_iso8601 iso_date' time_ let result' = (/= 0) result time_' <- (wrapPtr TimeVal) time_ freeMem iso_date' return (result', time_') -- function g_timeout_add_full -- Args : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_timeout_add_full" g_timeout_add_full :: Int32 -> -- priority : TBasicType TInt32 Word32 -> -- interval : TBasicType TUInt32 FunPtr SourceFuncC -> -- function : TInterface "GLib" "SourceFunc" Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO Word32 timeoutAdd :: (MonadIO m) => Int32 -> -- priority Word32 -> -- interval SourceFunc -> -- function m Word32 timeoutAdd priority interval function = liftIO $ do function' <- mkSourceFunc (sourceFuncWrapper Nothing function) let data_ = castFunPtrToPtr function' let notify = safeFreeFunPtrPtr result <- g_timeout_add_full priority interval function' data_ notify return result -- function g_timeout_add_seconds_full -- Args : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_timeout_add_seconds_full" g_timeout_add_seconds_full :: Int32 -> -- priority : TBasicType TInt32 Word32 -> -- interval : TBasicType TUInt32 FunPtr SourceFuncC -> -- function : TInterface "GLib" "SourceFunc" Ptr () -> -- data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO Word32 timeoutAddSeconds :: (MonadIO m) => Int32 -> -- priority Word32 -> -- interval SourceFunc -> -- function m Word32 timeoutAddSeconds priority interval function = liftIO $ do function' <- mkSourceFunc (sourceFuncWrapper Nothing function) let data_ = castFunPtrToPtr function' let notify = safeFreeFunPtrPtr result <- g_timeout_add_seconds_full priority interval function' data_ notify return result -- function g_timeout_source_new -- Args : [Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_timeout_source_new" g_timeout_source_new :: Word32 -> -- interval : TBasicType TUInt32 IO (Ptr Source) timeoutSourceNew :: (MonadIO m) => Word32 -> -- interval m Source timeoutSourceNew interval = liftIO $ do result <- g_timeout_source_new interval result' <- (wrapBoxed Source) result return result' -- function g_timeout_source_new_seconds -- Args : [Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "interval", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_timeout_source_new_seconds" g_timeout_source_new_seconds :: Word32 -> -- interval : TBasicType TUInt32 IO (Ptr Source) timeoutSourceNewSeconds :: (MonadIO m) => Word32 -> -- interval m Source timeoutSourceNewSeconds interval = liftIO $ do result <- g_timeout_source_new_seconds interval result' <- (wrapBoxed Source) result return result' -- function g_trash_stack_height -- Args : [Arg {argName = "stack_p", argType = TInterface "GLib" "TrashStack", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "stack_p", argType = TInterface "GLib" "TrashStack", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_trash_stack_height" g_trash_stack_height :: Ptr TrashStack -> -- stack_p : TInterface "GLib" "TrashStack" IO Word32 trashStackHeight :: (MonadIO m) => TrashStack -> -- stack_p m Word32 trashStackHeight stack_p = liftIO $ do let stack_p' = unsafeManagedPtrGetPtr stack_p result <- g_trash_stack_height stack_p' touchManagedPtr stack_p return result -- function g_trash_stack_push -- Args : [Arg {argName = "stack_p", argType = TInterface "GLib" "TrashStack", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data_p", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "stack_p", argType = TInterface "GLib" "TrashStack", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data_p", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_trash_stack_push" g_trash_stack_push :: Ptr TrashStack -> -- stack_p : TInterface "GLib" "TrashStack" Ptr () -> -- data_p : TBasicType TVoid IO () trashStackPush :: (MonadIO m) => TrashStack -> -- stack_p Ptr () -> -- data_p m () trashStackPush stack_p data_p = liftIO $ do let stack_p' = unsafeManagedPtrGetPtr stack_p g_trash_stack_push stack_p' data_p touchManagedPtr stack_p return () -- function g_unichar_break_type -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "UnicodeBreakType" -- throws : False -- Skip return : False foreign import ccall "g_unichar_break_type" g_unichar_break_type :: CInt -> -- c : TBasicType TUniChar IO CUInt unicharBreakType :: (MonadIO m) => Char -> -- c m UnicodeBreakType unicharBreakType c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_break_type c' let result' = (toEnum . fromIntegral) result return result' -- function g_unichar_combining_class -- Args : [Arg {argName = "uc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "uc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unichar_combining_class" g_unichar_combining_class :: CInt -> -- uc : TBasicType TUniChar IO Int32 unicharCombiningClass :: (MonadIO m) => Char -> -- uc m Int32 unicharCombiningClass uc = liftIO $ do let uc' = (fromIntegral . ord) uc result <- g_unichar_combining_class uc' return result -- function g_unichar_compose -- Args : [Arg {argName = "a", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "b", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "a", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "b", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_compose" g_unichar_compose :: CInt -> -- a : TBasicType TUniChar CInt -> -- b : TBasicType TUniChar CInt -> -- ch : TBasicType TUniChar IO CInt unicharCompose :: (MonadIO m) => Char -> -- a Char -> -- b Char -> -- ch m Bool unicharCompose a b ch = liftIO $ do let a' = (fromIntegral . ord) a let b' = (fromIntegral . ord) b let ch' = (fromIntegral . ord) ch result <- g_unichar_compose a' b' ch' let result' = (/= 0) result return result' -- function g_unichar_decompose -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "a", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "b", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "a", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "b", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_decompose" g_unichar_decompose :: CInt -> -- ch : TBasicType TUniChar CInt -> -- a : TBasicType TUniChar CInt -> -- b : TBasicType TUniChar IO CInt unicharDecompose :: (MonadIO m) => Char -> -- ch Char -> -- a Char -> -- b m Bool unicharDecompose ch a b = liftIO $ do let ch' = (fromIntegral . ord) ch let a' = (fromIntegral . ord) a let b' = (fromIntegral . ord) b result <- g_unichar_decompose ch' a' b' let result' = (/= 0) result return result' -- function g_unichar_digit_value -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unichar_digit_value" g_unichar_digit_value :: CInt -> -- c : TBasicType TUniChar IO Int32 unicharDigitValue :: (MonadIO m) => Char -> -- c m Int32 unicharDigitValue c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_digit_value c' return result -- function g_unichar_get_mirror_char -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mirrored_ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mirrored_ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_get_mirror_char" g_unichar_get_mirror_char :: CInt -> -- ch : TBasicType TUniChar CInt -> -- mirrored_ch : TBasicType TUniChar IO CInt unicharGetMirrorChar :: (MonadIO m) => Char -> -- ch Char -> -- mirrored_ch m Bool unicharGetMirrorChar ch mirrored_ch = liftIO $ do let ch' = (fromIntegral . ord) ch let mirrored_ch' = (fromIntegral . ord) mirrored_ch result <- g_unichar_get_mirror_char ch' mirrored_ch' let result' = (/= 0) result return result' -- function g_unichar_get_script -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "UnicodeScript" -- throws : False -- Skip return : False foreign import ccall "g_unichar_get_script" g_unichar_get_script :: CInt -> -- ch : TBasicType TUniChar IO CUInt unicharGetScript :: (MonadIO m) => Char -> -- ch m UnicodeScript unicharGetScript ch = liftIO $ do let ch' = (fromIntegral . ord) ch result <- g_unichar_get_script ch' let result' = (toEnum . fromIntegral) result return result' -- function g_unichar_isalnum -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isalnum" g_unichar_isalnum :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsalnum :: (MonadIO m) => Char -> -- c m Bool unicharIsalnum c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isalnum c' let result' = (/= 0) result return result' -- function g_unichar_isalpha -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isalpha" g_unichar_isalpha :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsalpha :: (MonadIO m) => Char -> -- c m Bool unicharIsalpha c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isalpha c' let result' = (/= 0) result return result' -- function g_unichar_iscntrl -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_iscntrl" g_unichar_iscntrl :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIscntrl :: (MonadIO m) => Char -> -- c m Bool unicharIscntrl c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_iscntrl c' let result' = (/= 0) result return result' -- function g_unichar_isdefined -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isdefined" g_unichar_isdefined :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsdefined :: (MonadIO m) => Char -> -- c m Bool unicharIsdefined c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isdefined c' let result' = (/= 0) result return result' -- function g_unichar_isdigit -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isdigit" g_unichar_isdigit :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsdigit :: (MonadIO m) => Char -> -- c m Bool unicharIsdigit c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isdigit c' let result' = (/= 0) result return result' -- function g_unichar_isgraph -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isgraph" g_unichar_isgraph :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsgraph :: (MonadIO m) => Char -> -- c m Bool unicharIsgraph c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isgraph c' let result' = (/= 0) result return result' -- function g_unichar_islower -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_islower" g_unichar_islower :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIslower :: (MonadIO m) => Char -> -- c m Bool unicharIslower c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_islower c' let result' = (/= 0) result return result' -- function g_unichar_ismark -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_ismark" g_unichar_ismark :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsmark :: (MonadIO m) => Char -> -- c m Bool unicharIsmark c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_ismark c' let result' = (/= 0) result return result' -- function g_unichar_isprint -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isprint" g_unichar_isprint :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsprint :: (MonadIO m) => Char -> -- c m Bool unicharIsprint c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isprint c' let result' = (/= 0) result return result' -- function g_unichar_ispunct -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_ispunct" g_unichar_ispunct :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIspunct :: (MonadIO m) => Char -> -- c m Bool unicharIspunct c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_ispunct c' let result' = (/= 0) result return result' -- function g_unichar_isspace -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isspace" g_unichar_isspace :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsspace :: (MonadIO m) => Char -> -- c m Bool unicharIsspace c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isspace c' let result' = (/= 0) result return result' -- function g_unichar_istitle -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_istitle" g_unichar_istitle :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIstitle :: (MonadIO m) => Char -> -- c m Bool unicharIstitle c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_istitle c' let result' = (/= 0) result return result' -- function g_unichar_isupper -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isupper" g_unichar_isupper :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsupper :: (MonadIO m) => Char -> -- c m Bool unicharIsupper c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isupper c' let result' = (/= 0) result return result' -- function g_unichar_iswide -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_iswide" g_unichar_iswide :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIswide :: (MonadIO m) => Char -> -- c m Bool unicharIswide c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_iswide c' let result' = (/= 0) result return result' -- function g_unichar_iswide_cjk -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_iswide_cjk" g_unichar_iswide_cjk :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIswideCjk :: (MonadIO m) => Char -> -- c m Bool unicharIswideCjk c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_iswide_cjk c' let result' = (/= 0) result return result' -- function g_unichar_isxdigit -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_isxdigit" g_unichar_isxdigit :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIsxdigit :: (MonadIO m) => Char -> -- c m Bool unicharIsxdigit c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_isxdigit c' let result' = (/= 0) result return result' -- function g_unichar_iszerowidth -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_iszerowidth" g_unichar_iszerowidth :: CInt -> -- c : TBasicType TUniChar IO CInt unicharIszerowidth :: (MonadIO m) => Char -> -- c m Bool unicharIszerowidth c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_iszerowidth c' let result' = (/= 0) result return result' -- function g_unichar_to_utf8 -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbuf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbuf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unichar_to_utf8" g_unichar_to_utf8 :: CInt -> -- c : TBasicType TUniChar CString -> -- outbuf : TBasicType TUTF8 IO Int32 unicharToUtf8 :: (MonadIO m) => Char -> -- c T.Text -> -- outbuf m Int32 unicharToUtf8 c outbuf = liftIO $ do let c' = (fromIntegral . ord) c outbuf' <- textToCString outbuf result <- g_unichar_to_utf8 c' outbuf' freeMem outbuf' return result -- function g_unichar_tolower -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUniChar -- throws : False -- Skip return : False foreign import ccall "g_unichar_tolower" g_unichar_tolower :: CInt -> -- c : TBasicType TUniChar IO CInt unicharTolower :: (MonadIO m) => Char -> -- c m Char unicharTolower c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_tolower c' let result' = (chr . fromIntegral) result return result' -- function g_unichar_totitle -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUniChar -- throws : False -- Skip return : False foreign import ccall "g_unichar_totitle" g_unichar_totitle :: CInt -> -- c : TBasicType TUniChar IO CInt unicharTotitle :: (MonadIO m) => Char -> -- c m Char unicharTotitle c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_totitle c' let result' = (chr . fromIntegral) result return result' -- function g_unichar_toupper -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUniChar -- throws : False -- Skip return : False foreign import ccall "g_unichar_toupper" g_unichar_toupper :: CInt -> -- c : TBasicType TUniChar IO CInt unicharToupper :: (MonadIO m) => Char -> -- c m Char unicharToupper c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_toupper c' let result' = (chr . fromIntegral) result return result' -- function g_unichar_type -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "UnicodeType" -- throws : False -- Skip return : False foreign import ccall "g_unichar_type" g_unichar_type :: CInt -> -- c : TBasicType TUniChar IO CUInt unicharType :: (MonadIO m) => Char -> -- c m UnicodeType unicharType c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_type c' let result' = (toEnum . fromIntegral) result return result' -- function g_unichar_validate -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unichar_validate" g_unichar_validate :: CInt -> -- ch : TBasicType TUniChar IO CInt unicharValidate :: (MonadIO m) => Char -> -- ch m Bool unicharValidate ch = liftIO $ do let ch' = (fromIntegral . ord) ch result <- g_unichar_validate ch' let result' = (/= 0) result return result' -- function g_unichar_xdigit_value -- Args : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unichar_xdigit_value" g_unichar_xdigit_value :: CInt -> -- c : TBasicType TUniChar IO Int32 unicharXdigitValue :: (MonadIO m) => Char -> -- c m Int32 unicharXdigitValue c = liftIO $ do let c' = (fromIntegral . ord) c result <- g_unichar_xdigit_value c' return result -- function g_unicode_canonical_decomposition -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUniChar -- throws : False -- Skip return : False foreign import ccall "g_unicode_canonical_decomposition" g_unicode_canonical_decomposition :: CInt -> -- ch : TBasicType TUniChar Word64 -> -- result_len : TBasicType TUInt64 IO CInt {-# DEPRECATED unicodeCanonicalDecomposition ["(Since version 2.30)","Use the more flexible g_unichar_fully_decompose()"," instead."]#-} unicodeCanonicalDecomposition :: (MonadIO m) => Char -> -- ch Word64 -> -- result_len m Char unicodeCanonicalDecomposition ch result_len = liftIO $ do let ch' = (fromIntegral . ord) ch result <- g_unicode_canonical_decomposition ch' result_len let result' = (chr . fromIntegral) result return result' -- function g_unicode_canonical_ordering -- Args : [Arg {argName = "string", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", 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_unicode_canonical_ordering" g_unicode_canonical_ordering :: CInt -> -- string : TBasicType TUniChar Word64 -> -- len : TBasicType TUInt64 IO () unicodeCanonicalOrdering :: (MonadIO m) => Char -> -- string Word64 -> -- len m () unicodeCanonicalOrdering string len = liftIO $ do let string' = (fromIntegral . ord) string g_unicode_canonical_ordering string' len return () -- function g_unicode_script_from_iso15924 -- Args : [Arg {argName = "iso15924", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "iso15924", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "UnicodeScript" -- throws : False -- Skip return : False foreign import ccall "g_unicode_script_from_iso15924" g_unicode_script_from_iso15924 :: Word32 -> -- iso15924 : TBasicType TUInt32 IO CUInt unicodeScriptFromIso15924 :: (MonadIO m) => Word32 -> -- iso15924 m UnicodeScript unicodeScriptFromIso15924 iso15924 = liftIO $ do result <- g_unicode_script_from_iso15924 iso15924 let result' = (toEnum . fromIntegral) result return result' -- function g_unicode_script_to_iso15924 -- Args : [Arg {argName = "script", argType = TInterface "GLib" "UnicodeScript", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "script", argType = TInterface "GLib" "UnicodeScript", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_unicode_script_to_iso15924" g_unicode_script_to_iso15924 :: CUInt -> -- script : TInterface "GLib" "UnicodeScript" IO Word32 unicodeScriptToIso15924 :: (MonadIO m) => UnicodeScript -> -- script m Word32 unicodeScriptToIso15924 script = liftIO $ do let script' = (fromIntegral . fromEnum) script result <- g_unicode_script_to_iso15924 script' return result -- function g_unix_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_unix_error_quark" g_unix_error_quark :: IO Word32 unixErrorQuark :: (MonadIO m) => m Word32 unixErrorQuark = liftIO $ do result <- g_unix_error_quark return result -- function g_unix_fd_add_full -- Args : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "condition", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "UnixFDSourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 4, argDestroy = 5, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "condition", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "function", argType = TInterface "GLib" "UnixFDSourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 4, argDestroy = 5, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_add_full" g_unix_fd_add_full :: Int32 -> -- priority : TBasicType TInt32 Int32 -> -- fd : TBasicType TInt32 CUInt -> -- condition : TInterface "GLib" "IOCondition" FunPtr UnixFDSourceFuncC -> -- function : TInterface "GLib" "UnixFDSourceFunc" Ptr () -> -- user_data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO Word32 unixFdAddFull :: (MonadIO m) => Int32 -> -- priority Int32 -> -- fd [IOCondition] -> -- condition UnixFDSourceFunc -> -- function m Word32 unixFdAddFull priority fd condition function = liftIO $ do let condition' = gflagsToWord condition function' <- mkUnixFDSourceFunc (unixFDSourceFuncWrapper Nothing function) let user_data = castFunPtrToPtr function' let notify = safeFreeFunPtrPtr result <- g_unix_fd_add_full priority fd condition' function' user_data notify return result -- function g_unix_fd_source_new -- Args : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "condition", argType = TInterface "GLib" "IOCondition", 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},Arg {argName = "condition", argType = TInterface "GLib" "IOCondition", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_source_new" g_unix_fd_source_new :: Int32 -> -- fd : TBasicType TInt32 CUInt -> -- condition : TInterface "GLib" "IOCondition" IO (Ptr Source) unixFdSourceNew :: (MonadIO m) => Int32 -> -- fd [IOCondition] -> -- condition m Source unixFdSourceNew fd condition = liftIO $ do let condition' = gflagsToWord condition result <- g_unix_fd_source_new fd condition' result' <- (wrapBoxed Source) result return result' -- function g_unix_open_pipe -- Args : [Arg {argName = "fds", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "fds", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_unix_open_pipe" g_unix_open_pipe :: Int32 -> -- fds : TBasicType TInt32 Int32 -> -- flags : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt unixOpenPipe :: (MonadIO m) => Int32 -> -- fds Int32 -> -- flags m () unixOpenPipe fds flags = liftIO $ do onException (do _ <- propagateGError $ g_unix_open_pipe fds flags return () ) (do return () ) -- function g_unix_set_fd_nonblocking -- Args : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nonblock", argType = TBasicType TBoolean, 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},Arg {argName = "nonblock", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_unix_set_fd_nonblocking" g_unix_set_fd_nonblocking :: Int32 -> -- fd : TBasicType TInt32 CInt -> -- nonblock : TBasicType TBoolean Ptr (Ptr GError) -> -- error IO CInt unixSetFdNonblocking :: (MonadIO m) => Int32 -> -- fd Bool -> -- nonblock m () unixSetFdNonblocking fd nonblock = liftIO $ do let nonblock' = (fromIntegral . fromEnum) nonblock onException (do _ <- propagateGError $ g_unix_set_fd_nonblocking fd nonblock' return () ) (do return () ) -- function g_unix_signal_add_full -- Args : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler", argType = TInterface "GLib" "SourceFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_unix_signal_add_full" g_unix_signal_add_full :: Int32 -> -- priority : TBasicType TInt32 Int32 -> -- signum : TBasicType TInt32 FunPtr SourceFuncC -> -- handler : TInterface "GLib" "SourceFunc" Ptr () -> -- user_data : TBasicType TVoid FunPtr DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO Word32 unixSignalAdd :: (MonadIO m) => Int32 -> -- priority Int32 -> -- signum SourceFunc -> -- handler m Word32 unixSignalAdd priority signum handler = liftIO $ do handler' <- mkSourceFunc (sourceFuncWrapper Nothing handler) let user_data = castFunPtrToPtr handler' let notify = safeFreeFunPtrPtr result <- g_unix_signal_add_full priority signum handler' user_data notify return result -- function g_unix_signal_source_new -- Args : [Arg {argName = "signum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "signum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_unix_signal_source_new" g_unix_signal_source_new :: Int32 -> -- signum : TBasicType TInt32 IO (Ptr Source) unixSignalSourceNew :: (MonadIO m) => Int32 -> -- signum m Source unixSignalSourceNew signum = liftIO $ do result <- g_unix_signal_source_new signum result' <- (wrapBoxed Source) result return result' -- function g_unlink -- Args : [Arg {argName = "filename", 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}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unlink" g_unlink :: CString -> -- filename : TBasicType TUTF8 IO Int32 unlink :: (MonadIO m) => T.Text -> -- filename m Int32 unlink filename = liftIO $ do filename' <- textToCString filename result <- g_unlink filename' freeMem filename' return result -- function g_unsetenv -- Args : [Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "variable", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_unsetenv" g_unsetenv :: CString -> -- variable : TBasicType TUTF8 IO () unsetenv :: (MonadIO m) => T.Text -> -- variable m () unsetenv variable = liftIO $ do variable' <- textToCString variable g_unsetenv variable' freeMem variable' return () -- function g_uri_escape_string -- Args : [Arg {argName = "unescaped", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reserved_chars_allowed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_utf8", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "unescaped", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reserved_chars_allowed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_utf8", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_uri_escape_string" g_uri_escape_string :: CString -> -- unescaped : TBasicType TUTF8 CString -> -- reserved_chars_allowed : TBasicType TUTF8 CInt -> -- allow_utf8 : TBasicType TBoolean IO CString uriEscapeString :: (MonadIO m) => T.Text -> -- unescaped Maybe (T.Text) -> -- reserved_chars_allowed Bool -> -- allow_utf8 m T.Text uriEscapeString unescaped reserved_chars_allowed allow_utf8 = liftIO $ do unescaped' <- textToCString unescaped maybeReserved_chars_allowed <- case reserved_chars_allowed of Nothing -> return nullPtr Just jReserved_chars_allowed -> do jReserved_chars_allowed' <- textToCString jReserved_chars_allowed return jReserved_chars_allowed' let allow_utf8' = (fromIntegral . fromEnum) allow_utf8 result <- g_uri_escape_string unescaped' maybeReserved_chars_allowed allow_utf8' result' <- cstringToText result freeMem result freeMem unescaped' freeMem maybeReserved_chars_allowed return result' -- function g_uri_list_extract_uris -- Args : [Arg {argName = "uri_list", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "uri_list", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_uri_list_extract_uris" g_uri_list_extract_uris :: CString -> -- uri_list : TBasicType TUTF8 IO (Ptr CString) uriListExtractUris :: (MonadIO m) => T.Text -> -- uri_list m [T.Text] uriListExtractUris uri_list = liftIO $ do uri_list' <- textToCString uri_list result <- g_uri_list_extract_uris uri_list' result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result freeMem uri_list' return result' -- function g_uri_parse_scheme -- Args : [Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_uri_parse_scheme" g_uri_parse_scheme :: CString -> -- uri : TBasicType TUTF8 IO CString uriParseScheme :: (MonadIO m) => T.Text -> -- uri m T.Text uriParseScheme uri = liftIO $ do uri' <- textToCString uri result <- g_uri_parse_scheme uri' result' <- cstringToText result freeMem result freeMem uri' return result' -- function g_uri_unescape_segment -- Args : [Arg {argName = "escaped_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "escaped_string_end", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "illegal_characters", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "escaped_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "escaped_string_end", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "illegal_characters", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_uri_unescape_segment" g_uri_unescape_segment :: CString -> -- escaped_string : TBasicType TUTF8 CString -> -- escaped_string_end : TBasicType TUTF8 CString -> -- illegal_characters : TBasicType TUTF8 IO CString uriUnescapeSegment :: (MonadIO m) => Maybe (T.Text) -> -- escaped_string Maybe (T.Text) -> -- escaped_string_end Maybe (T.Text) -> -- illegal_characters m T.Text uriUnescapeSegment escaped_string escaped_string_end illegal_characters = liftIO $ do maybeEscaped_string <- case escaped_string of Nothing -> return nullPtr Just jEscaped_string -> do jEscaped_string' <- textToCString jEscaped_string return jEscaped_string' maybeEscaped_string_end <- case escaped_string_end of Nothing -> return nullPtr Just jEscaped_string_end -> do jEscaped_string_end' <- textToCString jEscaped_string_end return jEscaped_string_end' maybeIllegal_characters <- case illegal_characters of Nothing -> return nullPtr Just jIllegal_characters -> do jIllegal_characters' <- textToCString jIllegal_characters return jIllegal_characters' result <- g_uri_unescape_segment maybeEscaped_string maybeEscaped_string_end maybeIllegal_characters result' <- cstringToText result freeMem result freeMem maybeEscaped_string freeMem maybeEscaped_string_end freeMem maybeIllegal_characters return result' -- function g_uri_unescape_string -- Args : [Arg {argName = "escaped_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "illegal_characters", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "escaped_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "illegal_characters", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_uri_unescape_string" g_uri_unescape_string :: CString -> -- escaped_string : TBasicType TUTF8 CString -> -- illegal_characters : TBasicType TUTF8 IO CString uriUnescapeString :: (MonadIO m) => T.Text -> -- escaped_string Maybe (T.Text) -> -- illegal_characters m T.Text uriUnescapeString escaped_string illegal_characters = liftIO $ do escaped_string' <- textToCString escaped_string maybeIllegal_characters <- case illegal_characters of Nothing -> return nullPtr Just jIllegal_characters -> do jIllegal_characters' <- textToCString jIllegal_characters return jIllegal_characters' result <- g_uri_unescape_string escaped_string' maybeIllegal_characters result' <- cstringToText result freeMem result freeMem escaped_string' freeMem maybeIllegal_characters return result' -- function g_usleep -- Args : [Arg {argName = "microseconds", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "microseconds", 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_usleep" g_usleep :: Word64 -> -- microseconds : TBasicType TUInt64 IO () usleep :: (MonadIO m) => Word64 -> -- microseconds m () usleep microseconds = liftIO $ do g_usleep microseconds return () -- function g_utf8_casefold -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_casefold" g_utf8_casefold :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString utf8Casefold :: (MonadIO m) => T.Text -> -- str Int64 -> -- len m T.Text utf8Casefold str len = liftIO $ do str' <- textToCString str result <- g_utf8_casefold str' len result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_collate -- Args : [Arg {argName = "str1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_utf8_collate" g_utf8_collate :: CString -> -- str1 : TBasicType TUTF8 CString -> -- str2 : TBasicType TUTF8 IO Int32 utf8Collate :: (MonadIO m) => T.Text -> -- str1 T.Text -> -- str2 m Int32 utf8Collate str1 str2 = liftIO $ do str1' <- textToCString str1 str2' <- textToCString str2 result <- g_utf8_collate str1' str2' freeMem str1' freeMem str2' return result -- function g_utf8_collate_key -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_collate_key" g_utf8_collate_key :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString utf8CollateKey :: (MonadIO m) => T.Text -> -- str Int64 -> -- len m T.Text utf8CollateKey str len = liftIO $ do str' <- textToCString str result <- g_utf8_collate_key str' len result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_collate_key_for_filename -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_collate_key_for_filename" g_utf8_collate_key_for_filename :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString utf8CollateKeyForFilename :: (MonadIO m) => T.Text -> -- str Int64 -> -- len m T.Text utf8CollateKeyForFilename str len = liftIO $ do str' <- textToCString str result <- g_utf8_collate_key_for_filename str' len result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_find_next_char -- Args : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_find_next_char" g_utf8_find_next_char :: CString -> -- p : TBasicType TUTF8 CString -> -- end : TBasicType TUTF8 IO CString utf8FindNextChar :: (MonadIO m) => T.Text -> -- p T.Text -> -- end m T.Text utf8FindNextChar p end = liftIO $ do p' <- textToCString p end' <- textToCString end result <- g_utf8_find_next_char p' end' result' <- cstringToText result freeMem result freeMem p' freeMem end' return result' -- function g_utf8_find_prev_char -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_find_prev_char" g_utf8_find_prev_char :: CString -> -- str : TBasicType TUTF8 CString -> -- p : TBasicType TUTF8 IO CString utf8FindPrevChar :: (MonadIO m) => T.Text -> -- str T.Text -> -- p m T.Text utf8FindPrevChar str p = liftIO $ do str' <- textToCString str p' <- textToCString p result <- g_utf8_find_prev_char str' p' result' <- cstringToText result freeMem result freeMem str' freeMem p' return result' -- function g_utf8_get_char -- Args : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUniChar -- throws : False -- Skip return : False foreign import ccall "g_utf8_get_char" g_utf8_get_char :: CString -> -- p : TBasicType TUTF8 IO CInt utf8GetChar :: (MonadIO m) => T.Text -> -- p m Char utf8GetChar p = liftIO $ do p' <- textToCString p result <- g_utf8_get_char p' let result' = (chr . fromIntegral) result freeMem p' return result' -- function g_utf8_get_char_validated -- Args : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUniChar -- throws : False -- Skip return : False foreign import ccall "g_utf8_get_char_validated" g_utf8_get_char_validated :: CString -> -- p : TBasicType TUTF8 Int64 -> -- max_len : TBasicType TInt64 IO CInt utf8GetCharValidated :: (MonadIO m) => T.Text -> -- p Int64 -> -- max_len m Char utf8GetCharValidated p max_len = liftIO $ do p' <- textToCString p result <- g_utf8_get_char_validated p' max_len let result' = (chr . fromIntegral) result freeMem p' return result' -- function g_utf8_normalize -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "GLib" "NormalizeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "GLib" "NormalizeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_normalize" g_utf8_normalize :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 CUInt -> -- mode : TInterface "GLib" "NormalizeMode" IO CString utf8Normalize :: (MonadIO m) => T.Text -> -- str Int64 -> -- len NormalizeMode -> -- mode m T.Text utf8Normalize str len mode = liftIO $ do str' <- textToCString str let mode' = (fromIntegral . fromEnum) mode result <- g_utf8_normalize str' len mode' result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_offset_to_pointer -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, 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}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_offset_to_pointer" g_utf8_offset_to_pointer :: CString -> -- str : TBasicType TUTF8 Int64 -> -- offset : TBasicType TInt64 IO CString utf8OffsetToPointer :: (MonadIO m) => T.Text -> -- str Int64 -> -- offset m T.Text utf8OffsetToPointer str offset = liftIO $ do str' <- textToCString str result <- g_utf8_offset_to_pointer str' offset result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_pointer_to_offset -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_utf8_pointer_to_offset" g_utf8_pointer_to_offset :: CString -> -- str : TBasicType TUTF8 CString -> -- pos : TBasicType TUTF8 IO Int64 utf8PointerToOffset :: (MonadIO m) => T.Text -> -- str T.Text -> -- pos m Int64 utf8PointerToOffset str pos = liftIO $ do str' <- textToCString str pos' <- textToCString pos result <- g_utf8_pointer_to_offset str' pos' freeMem str' freeMem pos' return result -- function g_utf8_prev_char -- Args : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_prev_char" g_utf8_prev_char :: CString -> -- p : TBasicType TUTF8 IO CString utf8PrevChar :: (MonadIO m) => T.Text -> -- p m T.Text utf8PrevChar p = liftIO $ do p' <- textToCString p result <- g_utf8_prev_char p' result' <- cstringToText result freeMem result freeMem p' return result' -- function g_utf8_strchr -- Args : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_strchr" g_utf8_strchr :: CString -> -- p : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 CInt -> -- c : TBasicType TUniChar IO CString utf8Strchr :: (MonadIO m) => T.Text -> -- p Int64 -> -- len Char -> -- c m T.Text utf8Strchr p len c = liftIO $ do p' <- textToCString p let c' = (fromIntegral . ord) c result <- g_utf8_strchr p' len c' result' <- cstringToText result freeMem result freeMem p' return result' -- function g_utf8_strdown -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_strdown" g_utf8_strdown :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString utf8Strdown :: (MonadIO m) => T.Text -> -- str Int64 -> -- len m T.Text utf8Strdown str len = liftIO $ do str' <- textToCString str result <- g_utf8_strdown str' len result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_strlen -- Args : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_utf8_strlen" g_utf8_strlen :: CString -> -- p : TBasicType TUTF8 Int64 -> -- max : TBasicType TInt64 IO Int64 utf8Strlen :: (MonadIO m) => T.Text -> -- p Int64 -> -- max m Int64 utf8Strlen p max = liftIO $ do p' <- textToCString p result <- g_utf8_strlen p' max freeMem p' return result -- function g_utf8_strncpy -- Args : [Arg {argName = "dest", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dest", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_strncpy" g_utf8_strncpy :: CString -> -- dest : TBasicType TUTF8 CString -> -- src : TBasicType TUTF8 Word64 -> -- n : TBasicType TUInt64 IO CString utf8Strncpy :: (MonadIO m) => T.Text -> -- dest T.Text -> -- src Word64 -> -- n m T.Text utf8Strncpy dest src n = liftIO $ do dest' <- textToCString dest src' <- textToCString src result <- g_utf8_strncpy dest' src' n result' <- cstringToText result freeMem result freeMem dest' freeMem src' return result' -- function g_utf8_strrchr -- Args : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "p", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_strrchr" g_utf8_strrchr :: CString -> -- p : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 CInt -> -- c : TBasicType TUniChar IO CString utf8Strrchr :: (MonadIO m) => T.Text -> -- p Int64 -> -- len Char -> -- c m T.Text utf8Strrchr p len c = liftIO $ do p' <- textToCString p let c' = (fromIntegral . ord) c result <- g_utf8_strrchr p' len c' result' <- cstringToText result freeMem result freeMem p' return result' -- function g_utf8_strreverse -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_strreverse" g_utf8_strreverse :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString utf8Strreverse :: (MonadIO m) => T.Text -> -- str Int64 -> -- len m T.Text utf8Strreverse str len = liftIO $ do str' <- textToCString str result <- g_utf8_strreverse str' len result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_strup -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_strup" g_utf8_strup :: CString -> -- str : TBasicType TUTF8 Int64 -> -- len : TBasicType TInt64 IO CString utf8Strup :: (MonadIO m) => T.Text -> -- str Int64 -> -- len m T.Text utf8Strup str len = liftIO $ do str' <- textToCString str result <- g_utf8_strup str' len result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_substring -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_utf8_substring" g_utf8_substring :: CString -> -- str : TBasicType TUTF8 Int64 -> -- start_pos : TBasicType TInt64 Int64 -> -- end_pos : TBasicType TInt64 IO CString utf8Substring :: (MonadIO m) => T.Text -> -- str Int64 -> -- start_pos Int64 -> -- end_pos m T.Text utf8Substring str start_pos end_pos = liftIO $ do str' <- textToCString str result <- g_utf8_substring str' start_pos end_pos result' <- cstringToText result freeMem result freeMem str' return result' -- function g_utf8_validate -- Args : [Arg {argName = "str", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "max_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "str", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_utf8_validate" g_utf8_validate :: Ptr Word8 -> -- str : TCArray False (-1) 1 (TBasicType TUInt8) Int64 -> -- max_len : TBasicType TInt64 Ptr CString -> -- end : TBasicType TUTF8 IO CInt utf8Validate :: (MonadIO m) => ByteString -> -- str m (Bool,T.Text) utf8Validate str = liftIO $ do let max_len = fromIntegral $ B.length str str' <- packByteString str end <- allocMem :: IO (Ptr CString) result <- g_utf8_validate str' max_len end let result' = (/= 0) result end' <- peek end end'' <- cstringToText end' freeMem str' freeMem end return (result', end'') -- function g_variant_get_gtype -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_variant_get_gtype" g_variant_get_gtype :: IO CGType variantGetGtype :: (MonadIO m) => m GType variantGetGtype = liftIO $ do result <- g_variant_get_gtype let result' = GType result return result' -- function g_variant_is_object_path -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_is_object_path" g_variant_is_object_path :: CString -> -- string : TBasicType TUTF8 IO CInt variantIsObjectPath :: (MonadIO m) => T.Text -> -- string m Bool variantIsObjectPath string = liftIO $ do string' <- textToCString string result <- g_variant_is_object_path string' let result' = (/= 0) result freeMem string' return result' -- function g_variant_is_signature -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_is_signature" g_variant_is_signature :: CString -> -- string : TBasicType TUTF8 IO CInt variantIsSignature :: (MonadIO m) => T.Text -> -- string m Bool variantIsSignature string = liftIO $ do string' <- textToCString string result <- g_variant_is_signature string' let result' = (/= 0) result freeMem string' return result' -- function g_variant_parse -- Args : [Arg {argName = "type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_variant_parse" g_variant_parse :: Ptr VariantType -> -- type : TInterface "GLib" "VariantType" CString -> -- text : TBasicType TUTF8 CString -> -- limit : TBasicType TUTF8 CString -> -- endptr : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr GVariant) variantParse :: (MonadIO m) => Maybe (VariantType) -> -- type T.Text -> -- text Maybe (T.Text) -> -- limit Maybe (T.Text) -> -- endptr m GVariant variantParse type_ text limit endptr = liftIO $ do maybeType_ <- case type_ of Nothing -> return nullPtr Just jType_ -> do let jType_' = unsafeManagedPtrGetPtr jType_ return jType_' text' <- textToCString text maybeLimit <- case limit of Nothing -> return nullPtr Just jLimit -> do jLimit' <- textToCString jLimit return jLimit' maybeEndptr <- case endptr of Nothing -> return nullPtr Just jEndptr -> do jEndptr' <- textToCString jEndptr return jEndptr' onException (do result <- propagateGError $ g_variant_parse maybeType_ text' maybeLimit maybeEndptr result' <- wrapGVariantPtr result whenJust type_ touchManagedPtr freeMem text' freeMem maybeLimit freeMem maybeEndptr return result' ) (do freeMem text' freeMem maybeLimit freeMem maybeEndptr ) -- function g_variant_parse_error_print_context -- Args : [Arg {argName = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_variant_parse_error_print_context" g_variant_parse_error_print_context :: Ptr GError -> -- error : TError CString -> -- source_str : TBasicType TUTF8 IO CString variantParseErrorPrintContext :: (MonadIO m) => GError -> -- error T.Text -> -- source_str m T.Text variantParseErrorPrintContext error_ source_str = liftIO $ do let error_' = unsafeManagedPtrGetPtr error_ source_str' <- textToCString source_str result <- g_variant_parse_error_print_context error_' source_str' result' <- cstringToText result freeMem result touchManagedPtr error_ freeMem source_str' return result' -- function g_variant_parse_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_variant_parse_error_quark" g_variant_parse_error_quark :: IO Word32 variantParseErrorQuark :: (MonadIO m) => m Word32 variantParseErrorQuark = liftIO $ do result <- g_variant_parse_error_quark return result -- function g_variant_parser_get_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_variant_parser_get_error_quark" g_variant_parser_get_error_quark :: IO Word32 {-# DEPRECATED variantParserGetErrorQuark ["Use g_variant_parse_error_quark() instead."]#-} variantParserGetErrorQuark :: (MonadIO m) => m Word32 variantParserGetErrorQuark = liftIO $ do result <- g_variant_parser_get_error_quark return result -- function g_variant_type_checked_ -- Args : [Arg {argName = "arg0", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "arg0", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "VariantType" -- throws : False -- Skip return : False foreign import ccall "g_variant_type_checked_" g_variant_type_checked_ :: CString -> -- arg0 : TBasicType TUTF8 IO (Ptr VariantType) variantTypeChecked_ :: (MonadIO m) => T.Text -> -- arg0 m VariantType variantTypeChecked_ arg0 = liftIO $ do arg0' <- textToCString arg0 result <- g_variant_type_checked_ arg0' result' <- (newBoxed VariantType) result freeMem arg0' return result' -- function g_variant_type_string_is_valid -- Args : [Arg {argName = "type_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_string_is_valid" g_variant_type_string_is_valid :: CString -> -- type_string : TBasicType TUTF8 IO CInt variantTypeStringIsValid :: (MonadIO m) => T.Text -> -- type_string m Bool variantTypeStringIsValid type_string = liftIO $ do type_string' <- textToCString type_string result <- g_variant_type_string_is_valid type_string' let result' = (/= 0) result freeMem type_string' return result' -- function g_variant_type_string_scan -- Args : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "endptr", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_variant_type_string_scan" g_variant_type_string_scan :: CString -> -- string : TBasicType TUTF8 CString -> -- limit : TBasicType TUTF8 Ptr CString -> -- endptr : TBasicType TUTF8 IO CInt variantTypeStringScan :: (MonadIO m) => T.Text -> -- string Maybe (T.Text) -> -- limit m (Bool,T.Text) variantTypeStringScan string limit = liftIO $ do string' <- textToCString string maybeLimit <- case limit of Nothing -> return nullPtr Just jLimit -> do jLimit' <- textToCString jLimit return jLimit' endptr <- allocMem :: IO (Ptr CString) result <- g_variant_type_string_scan string' maybeLimit endptr let result' = (/= 0) result endptr' <- peek endptr endptr'' <- cstringToText endptr' freeMem endptr' freeMem string' freeMem maybeLimit freeMem endptr return (result', endptr'') -- function g_warn_message -- Args : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warnexpr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "domain", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warnexpr", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_warn_message" g_warn_message :: CString -> -- domain : TBasicType TUTF8 CString -> -- file : TBasicType TUTF8 Int32 -> -- line : TBasicType TInt32 CString -> -- func : TBasicType TUTF8 CString -> -- warnexpr : TBasicType TUTF8 IO () warnMessage :: (MonadIO m) => T.Text -> -- domain T.Text -> -- file Int32 -> -- line T.Text -> -- func T.Text -> -- warnexpr m () warnMessage domain file line func warnexpr = liftIO $ do domain' <- textToCString domain file' <- textToCString file func' <- textToCString func warnexpr' <- textToCString warnexpr g_warn_message domain' file' line func' warnexpr' freeMem domain' freeMem file' freeMem func' freeMem warnexpr' return () -- callback IOFuncsIoReadFieldCallback iOFuncsIoReadFieldCallbackClosure :: IOFuncsIoReadFieldCallback -> IO Closure iOFuncsIoReadFieldCallbackClosure cb = newCClosure =<< mkIOFuncsIoReadFieldCallback wrapped where wrapped = iOFuncsIoReadFieldCallbackWrapper Nothing cb type IOFuncsIoReadFieldCallbackC = Ptr IOChannel -> CString -> Word64 -> Word64 -> IO CUInt foreign import ccall "wrapper" mkIOFuncsIoReadFieldCallback :: IOFuncsIoReadFieldCallbackC -> IO (FunPtr IOFuncsIoReadFieldCallbackC) type IOFuncsIoReadFieldCallback = IOChannel -> T.Text -> Word64 -> Word64 -> IO IOStatus noIOFuncsIoReadFieldCallback :: Maybe IOFuncsIoReadFieldCallback noIOFuncsIoReadFieldCallback = Nothing iOFuncsIoReadFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IOFuncsIoReadFieldCallbackC))) -> IOFuncsIoReadFieldCallback -> Ptr IOChannel -> CString -> Word64 -> Word64 -> IO CUInt iOFuncsIoReadFieldCallbackWrapper funptrptr _cb channel buf count bytes_read = do channel' <- (newBoxed IOChannel) channel buf' <- cstringToText buf result <- _cb channel' buf' count bytes_read maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback IOFuncsIoWriteFieldCallback iOFuncsIoWriteFieldCallbackClosure :: IOFuncsIoWriteFieldCallback -> IO Closure iOFuncsIoWriteFieldCallbackClosure cb = newCClosure =<< mkIOFuncsIoWriteFieldCallback wrapped where wrapped = iOFuncsIoWriteFieldCallbackWrapper Nothing cb type IOFuncsIoWriteFieldCallbackC = Ptr IOChannel -> CString -> Word64 -> Word64 -> IO CUInt foreign import ccall "wrapper" mkIOFuncsIoWriteFieldCallback :: IOFuncsIoWriteFieldCallbackC -> IO (FunPtr IOFuncsIoWriteFieldCallbackC) type IOFuncsIoWriteFieldCallback = IOChannel -> T.Text -> Word64 -> Word64 -> IO IOStatus noIOFuncsIoWriteFieldCallback :: Maybe IOFuncsIoWriteFieldCallback noIOFuncsIoWriteFieldCallback = Nothing iOFuncsIoWriteFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IOFuncsIoWriteFieldCallbackC))) -> IOFuncsIoWriteFieldCallback -> Ptr IOChannel -> CString -> Word64 -> Word64 -> IO CUInt iOFuncsIoWriteFieldCallbackWrapper funptrptr _cb channel buf count bytes_written = do channel' <- (newBoxed IOChannel) channel buf' <- cstringToText buf result <- _cb channel' buf' count bytes_written maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback IOFuncsIoSeekFieldCallback iOFuncsIoSeekFieldCallbackClosure :: IOFuncsIoSeekFieldCallback -> IO Closure iOFuncsIoSeekFieldCallbackClosure cb = newCClosure =<< mkIOFuncsIoSeekFieldCallback wrapped where wrapped = iOFuncsIoSeekFieldCallbackWrapper Nothing cb type IOFuncsIoSeekFieldCallbackC = Ptr IOChannel -> Int64 -> CUInt -> IO CUInt foreign import ccall "wrapper" mkIOFuncsIoSeekFieldCallback :: IOFuncsIoSeekFieldCallbackC -> IO (FunPtr IOFuncsIoSeekFieldCallbackC) type IOFuncsIoSeekFieldCallback = IOChannel -> Int64 -> SeekType -> IO IOStatus noIOFuncsIoSeekFieldCallback :: Maybe IOFuncsIoSeekFieldCallback noIOFuncsIoSeekFieldCallback = Nothing iOFuncsIoSeekFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IOFuncsIoSeekFieldCallbackC))) -> IOFuncsIoSeekFieldCallback -> Ptr IOChannel -> Int64 -> CUInt -> IO CUInt iOFuncsIoSeekFieldCallbackWrapper funptrptr _cb channel offset type_ = do channel' <- (newBoxed IOChannel) channel let type_' = (toEnum . fromIntegral) type_ result <- _cb channel' offset type_' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback IOFuncsIoCloseFieldCallback iOFuncsIoCloseFieldCallbackClosure :: IOFuncsIoCloseFieldCallback -> IO Closure iOFuncsIoCloseFieldCallbackClosure cb = newCClosure =<< mkIOFuncsIoCloseFieldCallback wrapped where wrapped = iOFuncsIoCloseFieldCallbackWrapper Nothing cb type IOFuncsIoCloseFieldCallbackC = Ptr IOChannel -> IO CUInt foreign import ccall "wrapper" mkIOFuncsIoCloseFieldCallback :: IOFuncsIoCloseFieldCallbackC -> IO (FunPtr IOFuncsIoCloseFieldCallbackC) type IOFuncsIoCloseFieldCallback = IOChannel -> IO IOStatus noIOFuncsIoCloseFieldCallback :: Maybe IOFuncsIoCloseFieldCallback noIOFuncsIoCloseFieldCallback = Nothing iOFuncsIoCloseFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IOFuncsIoCloseFieldCallbackC))) -> IOFuncsIoCloseFieldCallback -> Ptr IOChannel -> IO CUInt iOFuncsIoCloseFieldCallbackWrapper funptrptr _cb channel = do channel' <- (newBoxed IOChannel) channel result <- _cb channel' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback IOFuncsIoCreateWatchFieldCallback iOFuncsIoCreateWatchFieldCallbackClosure :: IOFuncsIoCreateWatchFieldCallback -> IO Closure iOFuncsIoCreateWatchFieldCallbackClosure cb = newCClosure =<< mkIOFuncsIoCreateWatchFieldCallback wrapped where wrapped = iOFuncsIoCreateWatchFieldCallbackWrapper Nothing cb type IOFuncsIoCreateWatchFieldCallbackC = Ptr IOChannel -> CUInt -> IO (Ptr Source) foreign import ccall "wrapper" mkIOFuncsIoCreateWatchFieldCallback :: IOFuncsIoCreateWatchFieldCallbackC -> IO (FunPtr IOFuncsIoCreateWatchFieldCallbackC) type IOFuncsIoCreateWatchFieldCallback = IOChannel -> [IOCondition] -> IO Source noIOFuncsIoCreateWatchFieldCallback :: Maybe IOFuncsIoCreateWatchFieldCallback noIOFuncsIoCreateWatchFieldCallback = Nothing iOFuncsIoCreateWatchFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IOFuncsIoCreateWatchFieldCallbackC))) -> IOFuncsIoCreateWatchFieldCallback -> Ptr IOChannel -> CUInt -> IO (Ptr Source) iOFuncsIoCreateWatchFieldCallbackWrapper funptrptr _cb channel condition = do channel' <- (newBoxed IOChannel) channel let condition' = wordToGFlags condition result <- _cb channel' condition' maybeReleaseFunPtr funptrptr result' <- copyBoxed result return result' -- callback IOFuncsIoFreeFieldCallback iOFuncsIoFreeFieldCallbackClosure :: IOFuncsIoFreeFieldCallback -> IO Closure iOFuncsIoFreeFieldCallbackClosure cb = newCClosure =<< mkIOFuncsIoFreeFieldCallback wrapped where wrapped = iOFuncsIoFreeFieldCallbackWrapper Nothing cb type IOFuncsIoFreeFieldCallbackC = Ptr IOChannel -> IO () foreign import ccall "wrapper" mkIOFuncsIoFreeFieldCallback :: IOFuncsIoFreeFieldCallbackC -> IO (FunPtr IOFuncsIoFreeFieldCallbackC) type IOFuncsIoFreeFieldCallback = IOChannel -> IO () noIOFuncsIoFreeFieldCallback :: Maybe IOFuncsIoFreeFieldCallback noIOFuncsIoFreeFieldCallback = Nothing iOFuncsIoFreeFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IOFuncsIoFreeFieldCallbackC))) -> IOFuncsIoFreeFieldCallback -> Ptr IOChannel -> IO () iOFuncsIoFreeFieldCallbackWrapper funptrptr _cb channel = do channel' <- (newBoxed IOChannel) channel _cb channel' maybeReleaseFunPtr funptrptr -- callback IOFuncsIoSetFlagsFieldCallback iOFuncsIoSetFlagsFieldCallbackClosure :: IOFuncsIoSetFlagsFieldCallback -> IO Closure iOFuncsIoSetFlagsFieldCallbackClosure cb = newCClosure =<< mkIOFuncsIoSetFlagsFieldCallback wrapped where wrapped = iOFuncsIoSetFlagsFieldCallbackWrapper Nothing cb type IOFuncsIoSetFlagsFieldCallbackC = Ptr IOChannel -> CUInt -> IO CUInt foreign import ccall "wrapper" mkIOFuncsIoSetFlagsFieldCallback :: IOFuncsIoSetFlagsFieldCallbackC -> IO (FunPtr IOFuncsIoSetFlagsFieldCallbackC) type IOFuncsIoSetFlagsFieldCallback = IOChannel -> [IOFlags] -> IO IOStatus noIOFuncsIoSetFlagsFieldCallback :: Maybe IOFuncsIoSetFlagsFieldCallback noIOFuncsIoSetFlagsFieldCallback = Nothing iOFuncsIoSetFlagsFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IOFuncsIoSetFlagsFieldCallbackC))) -> IOFuncsIoSetFlagsFieldCallback -> Ptr IOChannel -> CUInt -> IO CUInt iOFuncsIoSetFlagsFieldCallbackWrapper funptrptr _cb channel flags = do channel' <- (newBoxed IOChannel) channel let flags' = wordToGFlags flags result <- _cb channel' flags' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback IOFuncsIoGetFlagsFieldCallback iOFuncsIoGetFlagsFieldCallbackClosure :: IOFuncsIoGetFlagsFieldCallback -> IO Closure iOFuncsIoGetFlagsFieldCallbackClosure cb = newCClosure =<< mkIOFuncsIoGetFlagsFieldCallback wrapped where wrapped = iOFuncsIoGetFlagsFieldCallbackWrapper Nothing cb type IOFuncsIoGetFlagsFieldCallbackC = Ptr IOChannel -> IO CUInt foreign import ccall "wrapper" mkIOFuncsIoGetFlagsFieldCallback :: IOFuncsIoGetFlagsFieldCallbackC -> IO (FunPtr IOFuncsIoGetFlagsFieldCallbackC) type IOFuncsIoGetFlagsFieldCallback = IOChannel -> IO [IOFlags] noIOFuncsIoGetFlagsFieldCallback :: Maybe IOFuncsIoGetFlagsFieldCallback noIOFuncsIoGetFlagsFieldCallback = Nothing iOFuncsIoGetFlagsFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IOFuncsIoGetFlagsFieldCallbackC))) -> IOFuncsIoGetFlagsFieldCallback -> Ptr IOChannel -> IO CUInt iOFuncsIoGetFlagsFieldCallbackWrapper funptrptr _cb channel = do channel' <- (newBoxed IOChannel) channel result <- _cb channel' maybeReleaseFunPtr funptrptr let result' = gflagsToWord result return result' -- callback MarkupParserStartElementFieldCallback markupParserStartElementFieldCallbackClosure :: MarkupParserStartElementFieldCallback -> IO Closure markupParserStartElementFieldCallbackClosure cb = newCClosure =<< mkMarkupParserStartElementFieldCallback wrapped where wrapped = markupParserStartElementFieldCallbackWrapper Nothing cb type MarkupParserStartElementFieldCallbackC = Ptr MarkupParseContext -> CString -> CString -> CString -> Ptr () -> IO () foreign import ccall "wrapper" mkMarkupParserStartElementFieldCallback :: MarkupParserStartElementFieldCallbackC -> IO (FunPtr MarkupParserStartElementFieldCallbackC) type MarkupParserStartElementFieldCallback = MarkupParseContext -> T.Text -> T.Text -> T.Text -> IO () noMarkupParserStartElementFieldCallback :: Maybe MarkupParserStartElementFieldCallback noMarkupParserStartElementFieldCallback = Nothing markupParserStartElementFieldCallbackWrapper :: Maybe (Ptr (FunPtr (MarkupParserStartElementFieldCallbackC))) -> MarkupParserStartElementFieldCallback -> Ptr MarkupParseContext -> CString -> CString -> CString -> Ptr () -> IO () markupParserStartElementFieldCallbackWrapper funptrptr _cb context element_name attribute_names attribute_values _ = do context' <- (newBoxed MarkupParseContext) context element_name' <- cstringToText element_name attribute_names' <- cstringToText attribute_names attribute_values' <- cstringToText attribute_values _cb context' element_name' attribute_names' attribute_values' maybeReleaseFunPtr funptrptr -- callback MarkupParserEndElementFieldCallback markupParserEndElementFieldCallbackClosure :: MarkupParserEndElementFieldCallback -> IO Closure markupParserEndElementFieldCallbackClosure cb = newCClosure =<< mkMarkupParserEndElementFieldCallback wrapped where wrapped = markupParserEndElementFieldCallbackWrapper Nothing cb type MarkupParserEndElementFieldCallbackC = Ptr MarkupParseContext -> CString -> Ptr () -> IO () foreign import ccall "wrapper" mkMarkupParserEndElementFieldCallback :: MarkupParserEndElementFieldCallbackC -> IO (FunPtr MarkupParserEndElementFieldCallbackC) type MarkupParserEndElementFieldCallback = MarkupParseContext -> T.Text -> IO () noMarkupParserEndElementFieldCallback :: Maybe MarkupParserEndElementFieldCallback noMarkupParserEndElementFieldCallback = Nothing markupParserEndElementFieldCallbackWrapper :: Maybe (Ptr (FunPtr (MarkupParserEndElementFieldCallbackC))) -> MarkupParserEndElementFieldCallback -> Ptr MarkupParseContext -> CString -> Ptr () -> IO () markupParserEndElementFieldCallbackWrapper funptrptr _cb context element_name _ = do context' <- (newBoxed MarkupParseContext) context element_name' <- cstringToText element_name _cb context' element_name' maybeReleaseFunPtr funptrptr -- callback MarkupParserTextFieldCallback markupParserTextFieldCallbackClosure :: MarkupParserTextFieldCallback -> IO Closure markupParserTextFieldCallbackClosure cb = newCClosure =<< mkMarkupParserTextFieldCallback wrapped where wrapped = markupParserTextFieldCallbackWrapper Nothing cb type MarkupParserTextFieldCallbackC = Ptr MarkupParseContext -> CString -> Word64 -> Ptr () -> IO () foreign import ccall "wrapper" mkMarkupParserTextFieldCallback :: MarkupParserTextFieldCallbackC -> IO (FunPtr MarkupParserTextFieldCallbackC) type MarkupParserTextFieldCallback = MarkupParseContext -> T.Text -> Word64 -> IO () noMarkupParserTextFieldCallback :: Maybe MarkupParserTextFieldCallback noMarkupParserTextFieldCallback = Nothing markupParserTextFieldCallbackWrapper :: Maybe (Ptr (FunPtr (MarkupParserTextFieldCallbackC))) -> MarkupParserTextFieldCallback -> Ptr MarkupParseContext -> CString -> Word64 -> Ptr () -> IO () markupParserTextFieldCallbackWrapper funptrptr _cb context text text_len _ = do context' <- (newBoxed MarkupParseContext) context text' <- cstringToText text _cb context' text' text_len maybeReleaseFunPtr funptrptr -- callback MarkupParserPassthroughFieldCallback markupParserPassthroughFieldCallbackClosure :: MarkupParserPassthroughFieldCallback -> IO Closure markupParserPassthroughFieldCallbackClosure cb = newCClosure =<< mkMarkupParserPassthroughFieldCallback wrapped where wrapped = markupParserPassthroughFieldCallbackWrapper Nothing cb type MarkupParserPassthroughFieldCallbackC = Ptr MarkupParseContext -> CString -> Word64 -> Ptr () -> IO () foreign import ccall "wrapper" mkMarkupParserPassthroughFieldCallback :: MarkupParserPassthroughFieldCallbackC -> IO (FunPtr MarkupParserPassthroughFieldCallbackC) type MarkupParserPassthroughFieldCallback = MarkupParseContext -> T.Text -> Word64 -> IO () noMarkupParserPassthroughFieldCallback :: Maybe MarkupParserPassthroughFieldCallback noMarkupParserPassthroughFieldCallback = Nothing markupParserPassthroughFieldCallbackWrapper :: Maybe (Ptr (FunPtr (MarkupParserPassthroughFieldCallbackC))) -> MarkupParserPassthroughFieldCallback -> Ptr MarkupParseContext -> CString -> Word64 -> Ptr () -> IO () markupParserPassthroughFieldCallbackWrapper funptrptr _cb context passthrough_text text_len _ = do context' <- (newBoxed MarkupParseContext) context passthrough_text' <- cstringToText passthrough_text _cb context' passthrough_text' text_len maybeReleaseFunPtr funptrptr -- callback MarkupParserErrorFieldCallback markupParserErrorFieldCallbackClosure :: MarkupParserErrorFieldCallback -> IO Closure markupParserErrorFieldCallbackClosure cb = newCClosure =<< mkMarkupParserErrorFieldCallback wrapped where wrapped = markupParserErrorFieldCallbackWrapper Nothing cb type MarkupParserErrorFieldCallbackC = Ptr MarkupParseContext -> Ptr GError -> Ptr () -> IO () foreign import ccall "wrapper" mkMarkupParserErrorFieldCallback :: MarkupParserErrorFieldCallbackC -> IO (FunPtr MarkupParserErrorFieldCallbackC) type MarkupParserErrorFieldCallback = MarkupParseContext -> GError -> IO () noMarkupParserErrorFieldCallback :: Maybe MarkupParserErrorFieldCallback noMarkupParserErrorFieldCallback = Nothing markupParserErrorFieldCallbackWrapper :: Maybe (Ptr (FunPtr (MarkupParserErrorFieldCallbackC))) -> MarkupParserErrorFieldCallback -> Ptr MarkupParseContext -> Ptr GError -> Ptr () -> IO () markupParserErrorFieldCallbackWrapper funptrptr _cb context error_ _ = do context' <- (newBoxed MarkupParseContext) context error_' <- (newBoxed GError) error_ _cb context' error_' maybeReleaseFunPtr funptrptr -- callback MemVTableFreeFieldCallback memVTableFreeFieldCallbackClosure :: MemVTableFreeFieldCallback -> IO Closure memVTableFreeFieldCallbackClosure cb = newCClosure =<< mkMemVTableFreeFieldCallback wrapped where wrapped = memVTableFreeFieldCallbackWrapper Nothing cb type MemVTableFreeFieldCallbackC = Ptr () -> IO () foreign import ccall "wrapper" mkMemVTableFreeFieldCallback :: MemVTableFreeFieldCallbackC -> IO (FunPtr MemVTableFreeFieldCallbackC) type MemVTableFreeFieldCallback = Ptr () -> IO () noMemVTableFreeFieldCallback :: Maybe MemVTableFreeFieldCallback noMemVTableFreeFieldCallback = Nothing memVTableFreeFieldCallbackWrapper :: Maybe (Ptr (FunPtr (MemVTableFreeFieldCallbackC))) -> MemVTableFreeFieldCallback -> Ptr () -> IO () memVTableFreeFieldCallbackWrapper funptrptr _cb mem = do _cb mem maybeReleaseFunPtr funptrptr -- callback SourceCallbackFuncsRefFieldCallback sourceCallbackFuncsRefFieldCallbackClosure :: SourceCallbackFuncsRefFieldCallback -> IO Closure sourceCallbackFuncsRefFieldCallbackClosure cb = newCClosure =<< mkSourceCallbackFuncsRefFieldCallback wrapped where wrapped = sourceCallbackFuncsRefFieldCallbackWrapper Nothing cb type SourceCallbackFuncsRefFieldCallbackC = Ptr () -> IO () foreign import ccall "wrapper" mkSourceCallbackFuncsRefFieldCallback :: SourceCallbackFuncsRefFieldCallbackC -> IO (FunPtr SourceCallbackFuncsRefFieldCallbackC) type SourceCallbackFuncsRefFieldCallback = Ptr () -> IO () noSourceCallbackFuncsRefFieldCallback :: Maybe SourceCallbackFuncsRefFieldCallback noSourceCallbackFuncsRefFieldCallback = Nothing sourceCallbackFuncsRefFieldCallbackWrapper :: Maybe (Ptr (FunPtr (SourceCallbackFuncsRefFieldCallbackC))) -> SourceCallbackFuncsRefFieldCallback -> Ptr () -> IO () sourceCallbackFuncsRefFieldCallbackWrapper funptrptr _cb cb_data = do _cb cb_data maybeReleaseFunPtr funptrptr -- callback SourceCallbackFuncsUnrefFieldCallback sourceCallbackFuncsUnrefFieldCallbackClosure :: SourceCallbackFuncsUnrefFieldCallback -> IO Closure sourceCallbackFuncsUnrefFieldCallbackClosure cb = newCClosure =<< mkSourceCallbackFuncsUnrefFieldCallback wrapped where wrapped = sourceCallbackFuncsUnrefFieldCallbackWrapper Nothing cb type SourceCallbackFuncsUnrefFieldCallbackC = Ptr () -> IO () foreign import ccall "wrapper" mkSourceCallbackFuncsUnrefFieldCallback :: SourceCallbackFuncsUnrefFieldCallbackC -> IO (FunPtr SourceCallbackFuncsUnrefFieldCallbackC) type SourceCallbackFuncsUnrefFieldCallback = Ptr () -> IO () noSourceCallbackFuncsUnrefFieldCallback :: Maybe SourceCallbackFuncsUnrefFieldCallback noSourceCallbackFuncsUnrefFieldCallback = Nothing sourceCallbackFuncsUnrefFieldCallbackWrapper :: Maybe (Ptr (FunPtr (SourceCallbackFuncsUnrefFieldCallbackC))) -> SourceCallbackFuncsUnrefFieldCallback -> Ptr () -> IO () sourceCallbackFuncsUnrefFieldCallbackWrapper funptrptr _cb cb_data = do _cb cb_data maybeReleaseFunPtr funptrptr -- callback SourceFuncsPrepareFieldCallback sourceFuncsPrepareFieldCallbackClosure :: SourceFuncsPrepareFieldCallback -> IO Closure sourceFuncsPrepareFieldCallbackClosure cb = newCClosure =<< mkSourceFuncsPrepareFieldCallback wrapped where wrapped = sourceFuncsPrepareFieldCallbackWrapper Nothing cb type SourceFuncsPrepareFieldCallbackC = Ptr Source -> Int32 -> IO CInt foreign import ccall "wrapper" mkSourceFuncsPrepareFieldCallback :: SourceFuncsPrepareFieldCallbackC -> IO (FunPtr SourceFuncsPrepareFieldCallbackC) type SourceFuncsPrepareFieldCallback = Source -> Int32 -> IO Bool noSourceFuncsPrepareFieldCallback :: Maybe SourceFuncsPrepareFieldCallback noSourceFuncsPrepareFieldCallback = Nothing sourceFuncsPrepareFieldCallbackWrapper :: Maybe (Ptr (FunPtr (SourceFuncsPrepareFieldCallbackC))) -> SourceFuncsPrepareFieldCallback -> Ptr Source -> Int32 -> IO CInt sourceFuncsPrepareFieldCallbackWrapper funptrptr _cb source timeout_ = do source' <- (newBoxed Source) source result <- _cb source' timeout_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback SourceFuncsCheckFieldCallback sourceFuncsCheckFieldCallbackClosure :: SourceFuncsCheckFieldCallback -> IO Closure sourceFuncsCheckFieldCallbackClosure cb = newCClosure =<< mkSourceFuncsCheckFieldCallback wrapped where wrapped = sourceFuncsCheckFieldCallbackWrapper Nothing cb type SourceFuncsCheckFieldCallbackC = Ptr Source -> IO CInt foreign import ccall "wrapper" mkSourceFuncsCheckFieldCallback :: SourceFuncsCheckFieldCallbackC -> IO (FunPtr SourceFuncsCheckFieldCallbackC) type SourceFuncsCheckFieldCallback = Source -> IO Bool noSourceFuncsCheckFieldCallback :: Maybe SourceFuncsCheckFieldCallback noSourceFuncsCheckFieldCallback = Nothing sourceFuncsCheckFieldCallbackWrapper :: Maybe (Ptr (FunPtr (SourceFuncsCheckFieldCallbackC))) -> SourceFuncsCheckFieldCallback -> Ptr Source -> IO CInt sourceFuncsCheckFieldCallbackWrapper funptrptr _cb source = do source' <- (newBoxed Source) source result <- _cb source' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback SourceFuncsFinalizeFieldCallback sourceFuncsFinalizeFieldCallbackClosure :: SourceFuncsFinalizeFieldCallback -> IO Closure sourceFuncsFinalizeFieldCallbackClosure cb = newCClosure =<< mkSourceFuncsFinalizeFieldCallback wrapped where wrapped = sourceFuncsFinalizeFieldCallbackWrapper Nothing cb type SourceFuncsFinalizeFieldCallbackC = Ptr Source -> IO () foreign import ccall "wrapper" mkSourceFuncsFinalizeFieldCallback :: SourceFuncsFinalizeFieldCallbackC -> IO (FunPtr SourceFuncsFinalizeFieldCallbackC) type SourceFuncsFinalizeFieldCallback = Source -> IO () noSourceFuncsFinalizeFieldCallback :: Maybe SourceFuncsFinalizeFieldCallback noSourceFuncsFinalizeFieldCallback = Nothing sourceFuncsFinalizeFieldCallbackWrapper :: Maybe (Ptr (FunPtr (SourceFuncsFinalizeFieldCallbackC))) -> SourceFuncsFinalizeFieldCallback -> Ptr Source -> IO () sourceFuncsFinalizeFieldCallbackWrapper funptrptr _cb source = do source' <- (newBoxed Source) source _cb source' maybeReleaseFunPtr funptrptr