-- Generated code. {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE ForeignFunctionInterface, ConstraintKinds, TypeFamilies, MultiParamTypeClasses, KindSignatures, FlexibleInstances, UndecidableInstances, DataKinds, OverloadedStrings, NegativeLiterals, FlexibleContexts #-} module GI.Gio 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 import qualified GI.GLib as GLib import qualified GI.GLibAttributes as GLibA import qualified GI.GObject as GObject import qualified GI.GObjectAttributes as GObjectA -- interface Action newtype Action = Action (ForeignPtr Action) noAction :: Maybe Action noAction = Nothing foreign import ccall "g_action_get_type" c_g_action_get_type :: IO GType type instance ParentTypes Action = '[GObject.Object] instance GObject Action where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_action_get_type class GObject o => ActionK o instance (GObject o, IsDescendantOf Action o) => ActionK o toAction :: ActionK o => o -> IO Action toAction = unsafeCastTo Action -- method Action::activate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameter", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameter", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_action_activate" g_action_activate :: Ptr Action -> -- _obj : TInterface "Gio" "Action" Ptr GVariant -> -- parameter : TVariant IO () actionActivate :: (MonadIO m, ActionK a) => a -> -- _obj Maybe (GVariant) -> -- parameter m () actionActivate _obj parameter = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeParameter <- case parameter of Nothing -> return nullPtr Just jParameter -> do let jParameter' = unsafeManagedPtrGetPtr jParameter return jParameter' g_action_activate _obj' maybeParameter touchManagedPtr _obj return () -- method Action::change_state -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", 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 "Gio" "Action", 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_action_change_state" g_action_change_state :: Ptr Action -> -- _obj : TInterface "Gio" "Action" Ptr GVariant -> -- value : TVariant IO () actionChangeState :: (MonadIO m, ActionK a) => a -> -- _obj GVariant -> -- value m () actionChangeState _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let value' = unsafeManagedPtrGetPtr value g_action_change_state _obj' value' touchManagedPtr _obj return () -- method Action::get_enabled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_action_get_enabled" g_action_get_enabled :: Ptr Action -> -- _obj : TInterface "Gio" "Action" IO CInt actionGetEnabled :: (MonadIO m, ActionK a) => a -> -- _obj m Bool actionGetEnabled _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_action_get_enabled _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Action::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_action_get_name" g_action_get_name :: Ptr Action -> -- _obj : TInterface "Gio" "Action" IO CString actionGetName :: (MonadIO m, ActionK a) => a -> -- _obj m T.Text actionGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_action_get_name _obj' checkUnexpectedReturnNULL "g_action_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Action::get_parameter_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", 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_action_get_parameter_type" g_action_get_parameter_type :: Ptr Action -> -- _obj : TInterface "Gio" "Action" IO (Ptr GLib.VariantType) actionGetParameterType :: (MonadIO m, ActionK a) => a -> -- _obj m GLib.VariantType actionGetParameterType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_action_get_parameter_type _obj' checkUnexpectedReturnNULL "g_action_get_parameter_type" result result' <- (newBoxed GLib.VariantType) result touchManagedPtr _obj return result' -- method Action::get_state -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_action_get_state" g_action_get_state :: Ptr Action -> -- _obj : TInterface "Gio" "Action" IO (Ptr GVariant) actionGetState :: (MonadIO m, ActionK a) => a -> -- _obj m GVariant actionGetState _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_action_get_state _obj' checkUnexpectedReturnNULL "g_action_get_state" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method Action::get_state_hint -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_action_get_state_hint" g_action_get_state_hint :: Ptr Action -> -- _obj : TInterface "Gio" "Action" IO (Ptr GVariant) actionGetStateHint :: (MonadIO m, ActionK a) => a -> -- _obj m GVariant actionGetStateHint _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_action_get_state_hint _obj' checkUnexpectedReturnNULL "g_action_get_state_hint" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method Action::get_state_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Action", 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_action_get_state_type" g_action_get_state_type :: Ptr Action -> -- _obj : TInterface "Gio" "Action" IO (Ptr GLib.VariantType) actionGetStateType :: (MonadIO m, ActionK a) => a -> -- _obj m GLib.VariantType actionGetStateType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_action_get_state_type _obj' checkUnexpectedReturnNULL "g_action_get_state_type" result result' <- (newBoxed GLib.VariantType) result touchManagedPtr _obj return result' -- struct ActionEntry newtype ActionEntry = ActionEntry (ForeignPtr ActionEntry) noActionEntry :: Maybe ActionEntry noActionEntry = Nothing actionEntryReadName :: ActionEntry -> IO T.Text actionEntryReadName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' -- XXX Skipped getter for "ActionEntry:activate" :: Not implemented: "Wrapping foreign callbacks is not supported yet" actionEntryReadParameterType :: ActionEntry -> IO T.Text actionEntryReadParameterType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' actionEntryReadState :: ActionEntry -> IO T.Text actionEntryReadState s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO CString val' <- cstringToText val return val' -- XXX Skipped getter for "ActionEntry:change_state" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- interface ActionGroup newtype ActionGroup = ActionGroup (ForeignPtr ActionGroup) noActionGroup :: Maybe ActionGroup noActionGroup = Nothing foreign import ccall "g_action_group_get_type" c_g_action_group_get_type :: IO GType type instance ParentTypes ActionGroup = '[GObject.Object] instance GObject ActionGroup where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_action_group_get_type class GObject o => ActionGroupK o instance (GObject o, IsDescendantOf ActionGroup o) => ActionGroupK o toActionGroup :: ActionGroupK o => o -> IO ActionGroup toActionGroup = unsafeCastTo ActionGroup -- method ActionGroup::action_added -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_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_action_group_action_added" g_action_group_action_added :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 IO () actionGroupActionAdded :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m () actionGroupActionAdded _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name g_action_group_action_added _obj' action_name' touchManagedPtr _obj freeMem action_name' return () -- method ActionGroup::action_enabled_changed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enabled", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "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_action_group_action_enabled_changed" g_action_group_action_enabled_changed :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 CInt -> -- enabled : TBasicType TBoolean IO () actionGroupActionEnabledChanged :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name Bool -> -- enabled m () actionGroupActionEnabledChanged _obj action_name enabled = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name let enabled' = (fromIntegral . fromEnum) enabled g_action_group_action_enabled_changed _obj' action_name' enabled' touchManagedPtr _obj freeMem action_name' return () -- method ActionGroup::action_removed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_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_action_group_action_removed" g_action_group_action_removed :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 IO () actionGroupActionRemoved :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m () actionGroupActionRemoved _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name g_action_group_action_removed _obj' action_name' touchManagedPtr _obj freeMem action_name' return () -- method ActionGroup::action_state_changed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", 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_action_group_action_state_changed" g_action_group_action_state_changed :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 Ptr GVariant -> -- state : TVariant IO () actionGroupActionStateChanged :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name GVariant -> -- state m () actionGroupActionStateChanged _obj action_name state = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name let state' = unsafeManagedPtrGetPtr state g_action_group_action_state_changed _obj' action_name' state' touchManagedPtr _obj freeMem action_name' return () -- method ActionGroup::activate_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameter", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameter", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_action_group_activate_action" g_action_group_activate_action :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 Ptr GVariant -> -- parameter : TVariant IO () actionGroupActivateAction :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name Maybe (GVariant) -> -- parameter m () actionGroupActivateAction _obj action_name parameter = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name maybeParameter <- case parameter of Nothing -> return nullPtr Just jParameter -> do let jParameter' = unsafeManagedPtrGetPtr jParameter return jParameter' g_action_group_activate_action _obj' action_name' maybeParameter touchManagedPtr _obj freeMem action_name' return () -- method ActionGroup::change_action_state -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", 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 "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", 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_action_group_change_action_state" g_action_group_change_action_state :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 Ptr GVariant -> -- value : TVariant IO () actionGroupChangeActionState :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name GVariant -> -- value m () actionGroupChangeActionState _obj action_name value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name let value' = unsafeManagedPtrGetPtr value g_action_group_change_action_state _obj' action_name' value' touchManagedPtr _obj freeMem action_name' return () -- method ActionGroup::get_action_enabled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_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_action_group_get_action_enabled" g_action_group_get_action_enabled :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 IO CInt actionGroupGetActionEnabled :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m Bool actionGroupGetActionEnabled _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_action_group_get_action_enabled _obj' action_name' let result' = (/= 0) result touchManagedPtr _obj freeMem action_name' return result' -- method ActionGroup::get_action_parameter_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", 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_action_group_get_action_parameter_type" g_action_group_get_action_parameter_type :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 IO (Ptr GLib.VariantType) actionGroupGetActionParameterType :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m GLib.VariantType actionGroupGetActionParameterType _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_action_group_get_action_parameter_type _obj' action_name' checkUnexpectedReturnNULL "g_action_group_get_action_parameter_type" result result' <- (newBoxed GLib.VariantType) result touchManagedPtr _obj freeMem action_name' return result' -- method ActionGroup::get_action_state -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_action_group_get_action_state" g_action_group_get_action_state :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 IO (Ptr GVariant) actionGroupGetActionState :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m GVariant actionGroupGetActionState _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_action_group_get_action_state _obj' action_name' checkUnexpectedReturnNULL "g_action_group_get_action_state" result result' <- wrapGVariantPtr result touchManagedPtr _obj freeMem action_name' return result' -- method ActionGroup::get_action_state_hint -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_action_group_get_action_state_hint" g_action_group_get_action_state_hint :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 IO (Ptr GVariant) actionGroupGetActionStateHint :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m GVariant actionGroupGetActionStateHint _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_action_group_get_action_state_hint _obj' action_name' checkUnexpectedReturnNULL "g_action_group_get_action_state_hint" result result' <- wrapGVariantPtr result touchManagedPtr _obj freeMem action_name' return result' -- method ActionGroup::get_action_state_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", 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_action_group_get_action_state_type" g_action_group_get_action_state_type :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 IO (Ptr GLib.VariantType) actionGroupGetActionStateType :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m GLib.VariantType actionGroupGetActionStateType _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_action_group_get_action_state_type _obj' action_name' checkUnexpectedReturnNULL "g_action_group_get_action_state_type" result result' <- (wrapBoxed GLib.VariantType) result touchManagedPtr _obj freeMem action_name' return result' -- method ActionGroup::has_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_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_action_group_has_action" g_action_group_has_action :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 IO CInt actionGroupHasAction :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m Bool actionGroupHasAction _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_action_group_has_action _obj' action_name' let result' = (/= 0) result touchManagedPtr _obj freeMem action_name' return result' -- method ActionGroup::list_actions -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", 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_action_group_list_actions" g_action_group_list_actions :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" IO (Ptr CString) actionGroupListActions :: (MonadIO m, ActionGroupK a) => a -> -- _obj m [T.Text] actionGroupListActions _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_action_group_list_actions _obj' checkUnexpectedReturnNULL "g_action_group_list_actions" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method ActionGroup::query_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enabled", argType = TBasicType TBoolean, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "parameter_type", argType = TInterface "GLib" "VariantType", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "state_type", argType = TInterface "GLib" "VariantType", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "state_hint", argType = TVariant, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "state", argType = TVariant, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_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_action_group_query_action" g_action_group_query_action :: Ptr ActionGroup -> -- _obj : TInterface "Gio" "ActionGroup" CString -> -- action_name : TBasicType TUTF8 Ptr CInt -> -- enabled : TBasicType TBoolean Ptr (Ptr GLib.VariantType) -> -- parameter_type : TInterface "GLib" "VariantType" Ptr (Ptr GLib.VariantType) -> -- state_type : TInterface "GLib" "VariantType" Ptr (Ptr GVariant) -> -- state_hint : TVariant Ptr (Ptr GVariant) -> -- state : TVariant IO CInt actionGroupQueryAction :: (MonadIO m, ActionGroupK a) => a -> -- _obj T.Text -> -- action_name m (Bool,Bool,GLib.VariantType,GLib.VariantType,GVariant,GVariant) actionGroupQueryAction _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name enabled <- allocMem :: IO (Ptr CInt) parameter_type <- allocMem :: IO (Ptr (Ptr GLib.VariantType)) state_type <- allocMem :: IO (Ptr (Ptr GLib.VariantType)) state_hint <- allocMem :: IO (Ptr (Ptr GVariant)) state <- allocMem :: IO (Ptr (Ptr GVariant)) result <- g_action_group_query_action _obj' action_name' enabled parameter_type state_type state_hint state let result' = (/= 0) result enabled' <- peek enabled let enabled'' = (/= 0) enabled' parameter_type' <- peek parameter_type parameter_type'' <- (wrapBoxed GLib.VariantType) parameter_type' state_type' <- peek state_type state_type'' <- (wrapBoxed GLib.VariantType) state_type' state_hint' <- peek state_hint state_hint'' <- wrapGVariantPtr state_hint' state' <- peek state state'' <- wrapGVariantPtr state' touchManagedPtr _obj freeMem action_name' freeMem enabled freeMem parameter_type freeMem state_type freeMem state_hint freeMem state return (result', enabled'', parameter_type'', state_type'', state_hint'', state'') -- signal ActionGroup::action-added type ActionGroupActionAddedCallback = T.Text -> IO () noActionGroupActionAddedCallback :: Maybe ActionGroupActionAddedCallback noActionGroupActionAddedCallback = Nothing type ActionGroupActionAddedCallbackC = Ptr () -> -- object CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkActionGroupActionAddedCallback :: ActionGroupActionAddedCallbackC -> IO (FunPtr ActionGroupActionAddedCallbackC) actionGroupActionAddedClosure :: ActionGroupActionAddedCallback -> IO Closure actionGroupActionAddedClosure cb = newCClosure =<< mkActionGroupActionAddedCallback wrapped where wrapped = actionGroupActionAddedCallbackWrapper cb actionGroupActionAddedCallbackWrapper :: ActionGroupActionAddedCallback -> Ptr () -> CString -> Ptr () -> IO () actionGroupActionAddedCallbackWrapper _cb _ action_name _ = do action_name' <- cstringToText action_name _cb action_name' onActionGroupActionAdded :: (GObject a, MonadIO m) => a -> ActionGroupActionAddedCallback -> m SignalHandlerId onActionGroupActionAdded obj cb = liftIO $ connectActionGroupActionAdded obj cb SignalConnectBefore afterActionGroupActionAdded :: (GObject a, MonadIO m) => a -> ActionGroupActionAddedCallback -> m SignalHandlerId afterActionGroupActionAdded obj cb = connectActionGroupActionAdded obj cb SignalConnectAfter connectActionGroupActionAdded :: (GObject a, MonadIO m) => a -> ActionGroupActionAddedCallback -> SignalConnectMode -> m SignalHandlerId connectActionGroupActionAdded obj cb after = liftIO $ do cb' <- mkActionGroupActionAddedCallback (actionGroupActionAddedCallbackWrapper cb) connectSignalFunPtr obj "action-added" cb' after -- signal ActionGroup::action-enabled-changed type ActionGroupActionEnabledChangedCallback = T.Text -> Bool -> IO () noActionGroupActionEnabledChangedCallback :: Maybe ActionGroupActionEnabledChangedCallback noActionGroupActionEnabledChangedCallback = Nothing type ActionGroupActionEnabledChangedCallbackC = Ptr () -> -- object CString -> CInt -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkActionGroupActionEnabledChangedCallback :: ActionGroupActionEnabledChangedCallbackC -> IO (FunPtr ActionGroupActionEnabledChangedCallbackC) actionGroupActionEnabledChangedClosure :: ActionGroupActionEnabledChangedCallback -> IO Closure actionGroupActionEnabledChangedClosure cb = newCClosure =<< mkActionGroupActionEnabledChangedCallback wrapped where wrapped = actionGroupActionEnabledChangedCallbackWrapper cb actionGroupActionEnabledChangedCallbackWrapper :: ActionGroupActionEnabledChangedCallback -> Ptr () -> CString -> CInt -> Ptr () -> IO () actionGroupActionEnabledChangedCallbackWrapper _cb _ action_name enabled _ = do action_name' <- cstringToText action_name let enabled' = (/= 0) enabled _cb action_name' enabled' onActionGroupActionEnabledChanged :: (GObject a, MonadIO m) => a -> ActionGroupActionEnabledChangedCallback -> m SignalHandlerId onActionGroupActionEnabledChanged obj cb = liftIO $ connectActionGroupActionEnabledChanged obj cb SignalConnectBefore afterActionGroupActionEnabledChanged :: (GObject a, MonadIO m) => a -> ActionGroupActionEnabledChangedCallback -> m SignalHandlerId afterActionGroupActionEnabledChanged obj cb = connectActionGroupActionEnabledChanged obj cb SignalConnectAfter connectActionGroupActionEnabledChanged :: (GObject a, MonadIO m) => a -> ActionGroupActionEnabledChangedCallback -> SignalConnectMode -> m SignalHandlerId connectActionGroupActionEnabledChanged obj cb after = liftIO $ do cb' <- mkActionGroupActionEnabledChangedCallback (actionGroupActionEnabledChangedCallbackWrapper cb) connectSignalFunPtr obj "action-enabled-changed" cb' after -- signal ActionGroup::action-removed type ActionGroupActionRemovedCallback = T.Text -> IO () noActionGroupActionRemovedCallback :: Maybe ActionGroupActionRemovedCallback noActionGroupActionRemovedCallback = Nothing type ActionGroupActionRemovedCallbackC = Ptr () -> -- object CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkActionGroupActionRemovedCallback :: ActionGroupActionRemovedCallbackC -> IO (FunPtr ActionGroupActionRemovedCallbackC) actionGroupActionRemovedClosure :: ActionGroupActionRemovedCallback -> IO Closure actionGroupActionRemovedClosure cb = newCClosure =<< mkActionGroupActionRemovedCallback wrapped where wrapped = actionGroupActionRemovedCallbackWrapper cb actionGroupActionRemovedCallbackWrapper :: ActionGroupActionRemovedCallback -> Ptr () -> CString -> Ptr () -> IO () actionGroupActionRemovedCallbackWrapper _cb _ action_name _ = do action_name' <- cstringToText action_name _cb action_name' onActionGroupActionRemoved :: (GObject a, MonadIO m) => a -> ActionGroupActionRemovedCallback -> m SignalHandlerId onActionGroupActionRemoved obj cb = liftIO $ connectActionGroupActionRemoved obj cb SignalConnectBefore afterActionGroupActionRemoved :: (GObject a, MonadIO m) => a -> ActionGroupActionRemovedCallback -> m SignalHandlerId afterActionGroupActionRemoved obj cb = connectActionGroupActionRemoved obj cb SignalConnectAfter connectActionGroupActionRemoved :: (GObject a, MonadIO m) => a -> ActionGroupActionRemovedCallback -> SignalConnectMode -> m SignalHandlerId connectActionGroupActionRemoved obj cb after = liftIO $ do cb' <- mkActionGroupActionRemovedCallback (actionGroupActionRemovedCallbackWrapper cb) connectSignalFunPtr obj "action-removed" cb' after -- signal ActionGroup::action-state-changed type ActionGroupActionStateChangedCallback = T.Text -> GVariant -> IO () noActionGroupActionStateChangedCallback :: Maybe ActionGroupActionStateChangedCallback noActionGroupActionStateChangedCallback = Nothing type ActionGroupActionStateChangedCallbackC = Ptr () -> -- object CString -> Ptr GVariant -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkActionGroupActionStateChangedCallback :: ActionGroupActionStateChangedCallbackC -> IO (FunPtr ActionGroupActionStateChangedCallbackC) actionGroupActionStateChangedClosure :: ActionGroupActionStateChangedCallback -> IO Closure actionGroupActionStateChangedClosure cb = newCClosure =<< mkActionGroupActionStateChangedCallback wrapped where wrapped = actionGroupActionStateChangedCallbackWrapper cb actionGroupActionStateChangedCallbackWrapper :: ActionGroupActionStateChangedCallback -> Ptr () -> CString -> Ptr GVariant -> Ptr () -> IO () actionGroupActionStateChangedCallbackWrapper _cb _ action_name value _ = do action_name' <- cstringToText action_name value' <- newGVariantFromPtr value _cb action_name' value' onActionGroupActionStateChanged :: (GObject a, MonadIO m) => a -> ActionGroupActionStateChangedCallback -> m SignalHandlerId onActionGroupActionStateChanged obj cb = liftIO $ connectActionGroupActionStateChanged obj cb SignalConnectBefore afterActionGroupActionStateChanged :: (GObject a, MonadIO m) => a -> ActionGroupActionStateChangedCallback -> m SignalHandlerId afterActionGroupActionStateChanged obj cb = connectActionGroupActionStateChanged obj cb SignalConnectAfter connectActionGroupActionStateChanged :: (GObject a, MonadIO m) => a -> ActionGroupActionStateChangedCallback -> SignalConnectMode -> m SignalHandlerId connectActionGroupActionStateChanged obj cb after = liftIO $ do cb' <- mkActionGroupActionStateChangedCallback (actionGroupActionStateChangedCallbackWrapper cb) connectSignalFunPtr obj "action-state-changed" cb' after -- interface ActionMap newtype ActionMap = ActionMap (ForeignPtr ActionMap) noActionMap :: Maybe ActionMap noActionMap = Nothing foreign import ccall "g_action_map_get_type" c_g_action_map_get_type :: IO GType type instance ParentTypes ActionMap = '[GObject.Object] instance GObject ActionMap where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_action_map_get_type class GObject o => ActionMapK o instance (GObject o, IsDescendantOf ActionMap o) => ActionMapK o toActionMap :: ActionMapK o => o -> IO ActionMap toActionMap = unsafeCastTo ActionMap -- method ActionMap::add_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_action_map_add_action" g_action_map_add_action :: Ptr ActionMap -> -- _obj : TInterface "Gio" "ActionMap" Ptr Action -> -- action : TInterface "Gio" "Action" IO () actionMapAddAction :: (MonadIO m, ActionMapK a, ActionK b) => a -> -- _obj b -> -- action m () actionMapAddAction _obj action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let action' = unsafeManagedPtrCastPtr action g_action_map_add_action _obj' action' touchManagedPtr _obj touchManagedPtr action return () -- method ActionMap::add_action_entries -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TCArray False (-1) 2 (TInterface "Gio" "ActionEntry"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_entries", argType = TBasicType TInt32, 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 : [Arg {argName = "n_entries", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TCArray False (-1) 2 (TInterface "Gio" "ActionEntry"), 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_action_map_add_action_entries" g_action_map_add_action_entries :: Ptr ActionMap -> -- _obj : TInterface "Gio" "ActionMap" Ptr ActionEntry -> -- entries : TCArray False (-1) 2 (TInterface "Gio" "ActionEntry") Int32 -> -- n_entries : TBasicType TInt32 Ptr () -> -- user_data : TBasicType TVoid IO () actionMapAddActionEntries :: (MonadIO m, ActionMapK a) => a -> -- _obj [ActionEntry] -> -- entries Ptr () -> -- user_data m () actionMapAddActionEntries _obj entries user_data = liftIO $ do let n_entries = fromIntegral $ length entries let _obj' = unsafeManagedPtrCastPtr _obj let entries' = map unsafeManagedPtrGetPtr entries entries'' <- packBlockArray 64 entries' g_action_map_add_action_entries _obj' entries'' n_entries user_data touchManagedPtr _obj mapM_ touchManagedPtr entries freeMem entries'' return () -- method ActionMap::lookup_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Action" -- throws : False -- Skip return : False foreign import ccall "g_action_map_lookup_action" g_action_map_lookup_action :: Ptr ActionMap -> -- _obj : TInterface "Gio" "ActionMap" CString -> -- action_name : TBasicType TUTF8 IO (Ptr Action) actionMapLookupAction :: (MonadIO m, ActionMapK a) => a -> -- _obj T.Text -> -- action_name m Action actionMapLookupAction _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_action_map_lookup_action _obj' action_name' checkUnexpectedReturnNULL "g_action_map_lookup_action" result result' <- (newObject Action) result touchManagedPtr _obj freeMem action_name' return result' -- method ActionMap::remove_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ActionMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_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_action_map_remove_action" g_action_map_remove_action :: Ptr ActionMap -> -- _obj : TInterface "Gio" "ActionMap" CString -> -- action_name : TBasicType TUTF8 IO () actionMapRemoveAction :: (MonadIO m, ActionMapK a) => a -> -- _obj T.Text -> -- action_name m () actionMapRemoveAction _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name g_action_map_remove_action _obj' action_name' touchManagedPtr _obj freeMem action_name' return () -- interface AppInfo newtype AppInfo = AppInfo (ForeignPtr AppInfo) noAppInfo :: Maybe AppInfo noAppInfo = Nothing foreign import ccall "g_app_info_get_type" c_g_app_info_get_type :: IO GType type instance ParentTypes AppInfo = '[GObject.Object] instance GObject AppInfo where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_app_info_get_type class GObject o => AppInfoK o instance (GObject o, IsDescendantOf AppInfo o) => AppInfoK o toAppInfo :: AppInfoK o => o -> IO AppInfo toAppInfo = unsafeCastTo AppInfo -- method AppInfo::add_supports_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", 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_app_info_add_supports_type" g_app_info_add_supports_type :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" CString -> -- content_type : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt appInfoAddSupportsType :: (MonadIO m, AppInfoK a) => a -> -- _obj T.Text -> -- content_type m () appInfoAddSupportsType _obj content_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj content_type' <- textToCString content_type onException (do _ <- propagateGError $ g_app_info_add_supports_type _obj' content_type' touchManagedPtr _obj freeMem content_type' return () ) (do freeMem content_type' ) -- method AppInfo::can_delete -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_app_info_can_delete" g_app_info_can_delete :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CInt appInfoCanDelete :: (MonadIO m, AppInfoK a) => a -> -- _obj m Bool appInfoCanDelete _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_can_delete _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method AppInfo::can_remove_supports_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_app_info_can_remove_supports_type" g_app_info_can_remove_supports_type :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CInt appInfoCanRemoveSupportsType :: (MonadIO m, AppInfoK a) => a -> -- _obj m Bool appInfoCanRemoveSupportsType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_can_remove_supports_type _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method AppInfo::delete -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_app_info_delete" g_app_info_delete :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CInt appInfoDelete :: (MonadIO m, AppInfoK a) => a -> -- _obj m Bool appInfoDelete _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_delete _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method AppInfo::dup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "AppInfo" -- throws : False -- Skip return : False foreign import ccall "g_app_info_dup" g_app_info_dup :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO (Ptr AppInfo) appInfoDup :: (MonadIO m, AppInfoK a) => a -> -- _obj m AppInfo appInfoDup _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_dup _obj' checkUnexpectedReturnNULL "g_app_info_dup" result result' <- (wrapObject AppInfo) result touchManagedPtr _obj return result' -- method AppInfo::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "appinfo2", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "appinfo2", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_app_info_equal" g_app_info_equal :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" Ptr AppInfo -> -- appinfo2 : TInterface "Gio" "AppInfo" IO CInt appInfoEqual :: (MonadIO m, AppInfoK a, AppInfoK b) => a -> -- _obj b -> -- appinfo2 m Bool appInfoEqual _obj appinfo2 = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let appinfo2' = unsafeManagedPtrCastPtr appinfo2 result <- g_app_info_equal _obj' appinfo2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr appinfo2 return result' -- method AppInfo::get_commandline -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_commandline" g_app_info_get_commandline :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CString appInfoGetCommandline :: (MonadIO m, AppInfoK a) => a -> -- _obj m T.Text appInfoGetCommandline _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_get_commandline _obj' checkUnexpectedReturnNULL "g_app_info_get_commandline" result result' <- cstringToText result touchManagedPtr _obj return result' -- method AppInfo::get_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_description" g_app_info_get_description :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CString appInfoGetDescription :: (MonadIO m, AppInfoK a) => a -> -- _obj m T.Text appInfoGetDescription _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_get_description _obj' checkUnexpectedReturnNULL "g_app_info_get_description" result result' <- cstringToText result touchManagedPtr _obj return result' -- method AppInfo::get_display_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_display_name" g_app_info_get_display_name :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CString appInfoGetDisplayName :: (MonadIO m, AppInfoK a) => a -> -- _obj m T.Text appInfoGetDisplayName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_get_display_name _obj' checkUnexpectedReturnNULL "g_app_info_get_display_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method AppInfo::get_executable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_executable" g_app_info_get_executable :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CString appInfoGetExecutable :: (MonadIO m, AppInfoK a) => a -> -- _obj m T.Text appInfoGetExecutable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_get_executable _obj' checkUnexpectedReturnNULL "g_app_info_get_executable" result result' <- cstringToText result touchManagedPtr _obj return result' -- method AppInfo::get_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_icon" g_app_info_get_icon :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO (Ptr Icon) appInfoGetIcon :: (MonadIO m, AppInfoK a) => a -> -- _obj m Icon appInfoGetIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_get_icon _obj' checkUnexpectedReturnNULL "g_app_info_get_icon" result result' <- (newObject Icon) result touchManagedPtr _obj return result' -- method AppInfo::get_id -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_id" g_app_info_get_id :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CString appInfoGetId :: (MonadIO m, AppInfoK a) => a -> -- _obj m T.Text appInfoGetId _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_get_id _obj' checkUnexpectedReturnNULL "g_app_info_get_id" result result' <- cstringToText result touchManagedPtr _obj return result' -- method AppInfo::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_name" g_app_info_get_name :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CString appInfoGetName :: (MonadIO m, AppInfoK a) => a -> -- _obj m T.Text appInfoGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_get_name _obj' checkUnexpectedReturnNULL "g_app_info_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method AppInfo::get_supported_types -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", 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_app_info_get_supported_types" g_app_info_get_supported_types :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO (Ptr CString) appInfoGetSupportedTypes :: (MonadIO m, AppInfoK a) => a -> -- _obj m [T.Text] appInfoGetSupportedTypes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_get_supported_types _obj' checkUnexpectedReturnNULL "g_app_info_get_supported_types" result result' <- unpackZeroTerminatedUTF8CArray result touchManagedPtr _obj return result' -- method AppInfo::launch -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TGList (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "launch_context", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TGList (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "launch_context", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_app_info_launch" g_app_info_launch :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" Ptr (GList (Ptr File)) -> -- files : TGList (TInterface "Gio" "File") Ptr AppLaunchContext -> -- launch_context : TInterface "Gio" "AppLaunchContext" Ptr (Ptr GError) -> -- error IO CInt appInfoLaunch :: (MonadIO m, AppInfoK a, FileK b, AppLaunchContextK c) => a -> -- _obj [b] -> -- files Maybe (c) -> -- launch_context m () appInfoLaunch _obj files launch_context = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let files' = map unsafeManagedPtrCastPtr files files'' <- packGList files' maybeLaunch_context <- case launch_context of Nothing -> return nullPtr Just jLaunch_context -> do let jLaunch_context' = unsafeManagedPtrCastPtr jLaunch_context return jLaunch_context' onException (do _ <- propagateGError $ g_app_info_launch _obj' files'' maybeLaunch_context touchManagedPtr _obj mapM_ touchManagedPtr files whenJust launch_context touchManagedPtr g_list_free files'' return () ) (do g_list_free files'' ) -- method AppInfo::launch_uris -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uris", argType = TGList (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "launch_context", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uris", argType = TGList (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "launch_context", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_app_info_launch_uris" g_app_info_launch_uris :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" Ptr (GList CString) -> -- uris : TGList (TBasicType TUTF8) Ptr AppLaunchContext -> -- launch_context : TInterface "Gio" "AppLaunchContext" Ptr (Ptr GError) -> -- error IO CInt appInfoLaunchUris :: (MonadIO m, AppInfoK a, AppLaunchContextK b) => a -> -- _obj [T.Text] -> -- uris Maybe (b) -> -- launch_context m () appInfoLaunchUris _obj uris launch_context = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uris' <- mapM textToCString uris uris'' <- packGList uris' maybeLaunch_context <- case launch_context of Nothing -> return nullPtr Just jLaunch_context -> do let jLaunch_context' = unsafeManagedPtrCastPtr jLaunch_context return jLaunch_context' onException (do _ <- propagateGError $ g_app_info_launch_uris _obj' uris'' maybeLaunch_context touchManagedPtr _obj whenJust launch_context touchManagedPtr mapGList freeMem uris'' g_list_free uris'' return () ) (do mapGList freeMem uris'' g_list_free uris'' ) -- method AppInfo::remove_supports_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", 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_app_info_remove_supports_type" g_app_info_remove_supports_type :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" CString -> -- content_type : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt appInfoRemoveSupportsType :: (MonadIO m, AppInfoK a) => a -> -- _obj T.Text -> -- content_type m () appInfoRemoveSupportsType _obj content_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj content_type' <- textToCString content_type onException (do _ <- propagateGError $ g_app_info_remove_supports_type _obj' content_type' touchManagedPtr _obj freeMem content_type' return () ) (do freeMem content_type' ) -- method AppInfo::set_as_default_for_extension -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "extension", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "extension", 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_app_info_set_as_default_for_extension" g_app_info_set_as_default_for_extension :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" CString -> -- extension : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt appInfoSetAsDefaultForExtension :: (MonadIO m, AppInfoK a) => a -> -- _obj T.Text -> -- extension m () appInfoSetAsDefaultForExtension _obj extension = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj extension' <- textToCString extension onException (do _ <- propagateGError $ g_app_info_set_as_default_for_extension _obj' extension' touchManagedPtr _obj freeMem extension' return () ) (do freeMem extension' ) -- method AppInfo::set_as_default_for_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", 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_app_info_set_as_default_for_type" g_app_info_set_as_default_for_type :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" CString -> -- content_type : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt appInfoSetAsDefaultForType :: (MonadIO m, AppInfoK a) => a -> -- _obj T.Text -> -- content_type m () appInfoSetAsDefaultForType _obj content_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj content_type' <- textToCString content_type onException (do _ <- propagateGError $ g_app_info_set_as_default_for_type _obj' content_type' touchManagedPtr _obj freeMem content_type' return () ) (do freeMem content_type' ) -- method AppInfo::set_as_last_used_for_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", 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_app_info_set_as_last_used_for_type" g_app_info_set_as_last_used_for_type :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" CString -> -- content_type : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt appInfoSetAsLastUsedForType :: (MonadIO m, AppInfoK a) => a -> -- _obj T.Text -> -- content_type m () appInfoSetAsLastUsedForType _obj content_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj content_type' <- textToCString content_type onException (do _ <- propagateGError $ g_app_info_set_as_last_used_for_type _obj' content_type' touchManagedPtr _obj freeMem content_type' return () ) (do freeMem content_type' ) -- method AppInfo::should_show -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_app_info_should_show" g_app_info_should_show :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CInt appInfoShouldShow :: (MonadIO m, AppInfoK a) => a -> -- _obj m Bool appInfoShouldShow _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_should_show _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method AppInfo::supports_files -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_app_info_supports_files" g_app_info_supports_files :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CInt appInfoSupportsFiles :: (MonadIO m, AppInfoK a) => a -> -- _obj m Bool appInfoSupportsFiles _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_supports_files _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method AppInfo::supports_uris -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_app_info_supports_uris" g_app_info_supports_uris :: Ptr AppInfo -> -- _obj : TInterface "Gio" "AppInfo" IO CInt appInfoSupportsUris :: (MonadIO m, AppInfoK a) => a -> -- _obj m Bool appInfoSupportsUris _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_info_supports_uris _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- Flags AppInfoCreateFlags data AppInfoCreateFlags = AppInfoCreateFlagsNone | AppInfoCreateFlagsNeedsTerminal | AppInfoCreateFlagsSupportsUris | AppInfoCreateFlagsSupportsStartupNotification | AnotherAppInfoCreateFlags Int deriving (Show, Eq) instance Enum AppInfoCreateFlags where fromEnum AppInfoCreateFlagsNone = 0 fromEnum AppInfoCreateFlagsNeedsTerminal = 1 fromEnum AppInfoCreateFlagsSupportsUris = 2 fromEnum AppInfoCreateFlagsSupportsStartupNotification = 4 fromEnum (AnotherAppInfoCreateFlags k) = k toEnum 0 = AppInfoCreateFlagsNone toEnum 1 = AppInfoCreateFlagsNeedsTerminal toEnum 2 = AppInfoCreateFlagsSupportsUris toEnum 4 = AppInfoCreateFlagsSupportsStartupNotification toEnum k = AnotherAppInfoCreateFlags k foreign import ccall "g_app_info_create_flags_get_type" c_g_app_info_create_flags_get_type :: IO GType instance BoxedEnum AppInfoCreateFlags where boxedEnumType _ = c_g_app_info_create_flags_get_type instance IsGFlag AppInfoCreateFlags -- object AppInfoMonitor newtype AppInfoMonitor = AppInfoMonitor (ForeignPtr AppInfoMonitor) noAppInfoMonitor :: Maybe AppInfoMonitor noAppInfoMonitor = Nothing foreign import ccall "g_app_info_monitor_get_type" c_g_app_info_monitor_get_type :: IO GType type instance ParentTypes AppInfoMonitor = '[GObject.Object] instance GObject AppInfoMonitor where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_app_info_monitor_get_type class GObject o => AppInfoMonitorK o instance (GObject o, IsDescendantOf AppInfoMonitor o) => AppInfoMonitorK o toAppInfoMonitor :: AppInfoMonitorK o => o -> IO AppInfoMonitor toAppInfoMonitor = unsafeCastTo AppInfoMonitor -- method AppInfoMonitor::get -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "AppInfoMonitor" -- throws : False -- Skip return : False foreign import ccall "g_app_info_monitor_get" g_app_info_monitor_get :: IO (Ptr AppInfoMonitor) appInfoMonitorGet :: (MonadIO m) => m AppInfoMonitor appInfoMonitorGet = liftIO $ do result <- g_app_info_monitor_get checkUnexpectedReturnNULL "g_app_info_monitor_get" result result' <- (wrapObject AppInfoMonitor) result return result' -- signal AppInfoMonitor::changed type AppInfoMonitorChangedCallback = IO () noAppInfoMonitorChangedCallback :: Maybe AppInfoMonitorChangedCallback noAppInfoMonitorChangedCallback = Nothing type AppInfoMonitorChangedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkAppInfoMonitorChangedCallback :: AppInfoMonitorChangedCallbackC -> IO (FunPtr AppInfoMonitorChangedCallbackC) appInfoMonitorChangedClosure :: AppInfoMonitorChangedCallback -> IO Closure appInfoMonitorChangedClosure cb = newCClosure =<< mkAppInfoMonitorChangedCallback wrapped where wrapped = appInfoMonitorChangedCallbackWrapper cb appInfoMonitorChangedCallbackWrapper :: AppInfoMonitorChangedCallback -> Ptr () -> Ptr () -> IO () appInfoMonitorChangedCallbackWrapper _cb _ _ = do _cb onAppInfoMonitorChanged :: (GObject a, MonadIO m) => a -> AppInfoMonitorChangedCallback -> m SignalHandlerId onAppInfoMonitorChanged obj cb = liftIO $ connectAppInfoMonitorChanged obj cb SignalConnectBefore afterAppInfoMonitorChanged :: (GObject a, MonadIO m) => a -> AppInfoMonitorChangedCallback -> m SignalHandlerId afterAppInfoMonitorChanged obj cb = connectAppInfoMonitorChanged obj cb SignalConnectAfter connectAppInfoMonitorChanged :: (GObject a, MonadIO m) => a -> AppInfoMonitorChangedCallback -> SignalConnectMode -> m SignalHandlerId connectAppInfoMonitorChanged obj cb after = liftIO $ do cb' <- mkAppInfoMonitorChangedCallback (appInfoMonitorChangedCallbackWrapper cb) connectSignalFunPtr obj "changed" cb' after -- object AppLaunchContext newtype AppLaunchContext = AppLaunchContext (ForeignPtr AppLaunchContext) noAppLaunchContext :: Maybe AppLaunchContext noAppLaunchContext = Nothing foreign import ccall "g_app_launch_context_get_type" c_g_app_launch_context_get_type :: IO GType type instance ParentTypes AppLaunchContext = '[GObject.Object] instance GObject AppLaunchContext where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_app_launch_context_get_type class GObject o => AppLaunchContextK o instance (GObject o, IsDescendantOf AppLaunchContext o) => AppLaunchContextK o toAppLaunchContext :: AppLaunchContextK o => o -> IO AppLaunchContext toAppLaunchContext = unsafeCastTo AppLaunchContext -- method AppLaunchContext::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "AppLaunchContext" -- throws : False -- Skip return : False foreign import ccall "g_app_launch_context_new" g_app_launch_context_new :: IO (Ptr AppLaunchContext) appLaunchContextNew :: (MonadIO m) => m AppLaunchContext appLaunchContextNew = liftIO $ do result <- g_app_launch_context_new checkUnexpectedReturnNULL "g_app_launch_context_new" result result' <- (wrapObject AppLaunchContext) result return result' -- method AppLaunchContext::get_display -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TGList (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TGList (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_app_launch_context_get_display" g_app_launch_context_get_display :: Ptr AppLaunchContext -> -- _obj : TInterface "Gio" "AppLaunchContext" Ptr AppInfo -> -- info : TInterface "Gio" "AppInfo" Ptr (GList (Ptr File)) -> -- files : TGList (TInterface "Gio" "File") IO CString appLaunchContextGetDisplay :: (MonadIO m, AppLaunchContextK a, AppInfoK b, FileK c) => a -> -- _obj b -> -- info [c] -> -- files m T.Text appLaunchContextGetDisplay _obj info files = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let info' = unsafeManagedPtrCastPtr info let files' = map unsafeManagedPtrCastPtr files files'' <- packGList files' result <- g_app_launch_context_get_display _obj' info' files'' checkUnexpectedReturnNULL "g_app_launch_context_get_display" result result' <- cstringToText result freeMem result touchManagedPtr _obj touchManagedPtr info mapM_ touchManagedPtr files g_list_free files'' return result' -- method AppLaunchContext::get_environment -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", 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_app_launch_context_get_environment" g_app_launch_context_get_environment :: Ptr AppLaunchContext -> -- _obj : TInterface "Gio" "AppLaunchContext" IO (Ptr CString) appLaunchContextGetEnvironment :: (MonadIO m, AppLaunchContextK a) => a -> -- _obj m [T.Text] appLaunchContextGetEnvironment _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_app_launch_context_get_environment _obj' checkUnexpectedReturnNULL "g_app_launch_context_get_environment" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method AppLaunchContext::get_startup_notify_id -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TGList (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "AppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TGList (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_app_launch_context_get_startup_notify_id" g_app_launch_context_get_startup_notify_id :: Ptr AppLaunchContext -> -- _obj : TInterface "Gio" "AppLaunchContext" Ptr AppInfo -> -- info : TInterface "Gio" "AppInfo" Ptr (GList (Ptr File)) -> -- files : TGList (TInterface "Gio" "File") IO CString appLaunchContextGetStartupNotifyId :: (MonadIO m, AppLaunchContextK a, AppInfoK b, FileK c) => a -> -- _obj b -> -- info [c] -> -- files m T.Text appLaunchContextGetStartupNotifyId _obj info files = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let info' = unsafeManagedPtrCastPtr info let files' = map unsafeManagedPtrCastPtr files files'' <- packGList files' result <- g_app_launch_context_get_startup_notify_id _obj' info' files'' checkUnexpectedReturnNULL "g_app_launch_context_get_startup_notify_id" result result' <- cstringToText result freeMem result touchManagedPtr _obj touchManagedPtr info mapM_ touchManagedPtr files g_list_free files'' return result' -- method AppLaunchContext::launch_failed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "startup_notify_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "startup_notify_id", 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_app_launch_context_launch_failed" g_app_launch_context_launch_failed :: Ptr AppLaunchContext -> -- _obj : TInterface "Gio" "AppLaunchContext" CString -> -- startup_notify_id : TBasicType TUTF8 IO () appLaunchContextLaunchFailed :: (MonadIO m, AppLaunchContextK a) => a -> -- _obj T.Text -> -- startup_notify_id m () appLaunchContextLaunchFailed _obj startup_notify_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj startup_notify_id' <- textToCString startup_notify_id g_app_launch_context_launch_failed _obj' startup_notify_id' touchManagedPtr _obj freeMem startup_notify_id' return () -- method AppLaunchContext::setenv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, 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},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 "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, 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},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_app_launch_context_setenv" g_app_launch_context_setenv :: Ptr AppLaunchContext -> -- _obj : TInterface "Gio" "AppLaunchContext" CString -> -- variable : TBasicType TUTF8 CString -> -- value : TBasicType TUTF8 IO () appLaunchContextSetenv :: (MonadIO m, AppLaunchContextK a) => a -> -- _obj T.Text -> -- variable T.Text -> -- value m () appLaunchContextSetenv _obj variable value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj variable' <- textToCString variable value' <- textToCString value g_app_launch_context_setenv _obj' variable' value' touchManagedPtr _obj freeMem variable' freeMem value' return () -- method AppLaunchContext::unsetenv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, 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 = "_obj", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = False, 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 TVoid -- throws : False -- Skip return : False foreign import ccall "g_app_launch_context_unsetenv" g_app_launch_context_unsetenv :: Ptr AppLaunchContext -> -- _obj : TInterface "Gio" "AppLaunchContext" CString -> -- variable : TBasicType TUTF8 IO () appLaunchContextUnsetenv :: (MonadIO m, AppLaunchContextK a) => a -> -- _obj T.Text -> -- variable m () appLaunchContextUnsetenv _obj variable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj variable' <- textToCString variable g_app_launch_context_unsetenv _obj' variable' touchManagedPtr _obj freeMem variable' return () -- signal AppLaunchContext::launch-failed type AppLaunchContextLaunchFailedCallback = T.Text -> IO () noAppLaunchContextLaunchFailedCallback :: Maybe AppLaunchContextLaunchFailedCallback noAppLaunchContextLaunchFailedCallback = Nothing type AppLaunchContextLaunchFailedCallbackC = Ptr () -> -- object CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkAppLaunchContextLaunchFailedCallback :: AppLaunchContextLaunchFailedCallbackC -> IO (FunPtr AppLaunchContextLaunchFailedCallbackC) appLaunchContextLaunchFailedClosure :: AppLaunchContextLaunchFailedCallback -> IO Closure appLaunchContextLaunchFailedClosure cb = newCClosure =<< mkAppLaunchContextLaunchFailedCallback wrapped where wrapped = appLaunchContextLaunchFailedCallbackWrapper cb appLaunchContextLaunchFailedCallbackWrapper :: AppLaunchContextLaunchFailedCallback -> Ptr () -> CString -> Ptr () -> IO () appLaunchContextLaunchFailedCallbackWrapper _cb _ startup_notify_id _ = do startup_notify_id' <- cstringToText startup_notify_id _cb startup_notify_id' onAppLaunchContextLaunchFailed :: (GObject a, MonadIO m) => a -> AppLaunchContextLaunchFailedCallback -> m SignalHandlerId onAppLaunchContextLaunchFailed obj cb = liftIO $ connectAppLaunchContextLaunchFailed obj cb SignalConnectBefore afterAppLaunchContextLaunchFailed :: (GObject a, MonadIO m) => a -> AppLaunchContextLaunchFailedCallback -> m SignalHandlerId afterAppLaunchContextLaunchFailed obj cb = connectAppLaunchContextLaunchFailed obj cb SignalConnectAfter connectAppLaunchContextLaunchFailed :: (GObject a, MonadIO m) => a -> AppLaunchContextLaunchFailedCallback -> SignalConnectMode -> m SignalHandlerId connectAppLaunchContextLaunchFailed obj cb after = liftIO $ do cb' <- mkAppLaunchContextLaunchFailedCallback (appLaunchContextLaunchFailedCallbackWrapper cb) connectSignalFunPtr obj "launch-failed" cb' after -- signal AppLaunchContext::launched type AppLaunchContextLaunchedCallback = AppInfo -> GVariant -> IO () noAppLaunchContextLaunchedCallback :: Maybe AppLaunchContextLaunchedCallback noAppLaunchContextLaunchedCallback = Nothing type AppLaunchContextLaunchedCallbackC = Ptr () -> -- object Ptr AppInfo -> Ptr GVariant -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkAppLaunchContextLaunchedCallback :: AppLaunchContextLaunchedCallbackC -> IO (FunPtr AppLaunchContextLaunchedCallbackC) appLaunchContextLaunchedClosure :: AppLaunchContextLaunchedCallback -> IO Closure appLaunchContextLaunchedClosure cb = newCClosure =<< mkAppLaunchContextLaunchedCallback wrapped where wrapped = appLaunchContextLaunchedCallbackWrapper cb appLaunchContextLaunchedCallbackWrapper :: AppLaunchContextLaunchedCallback -> Ptr () -> Ptr AppInfo -> Ptr GVariant -> Ptr () -> IO () appLaunchContextLaunchedCallbackWrapper _cb _ info platform_data _ = do info' <- (newObject AppInfo) info platform_data' <- newGVariantFromPtr platform_data _cb info' platform_data' onAppLaunchContextLaunched :: (GObject a, MonadIO m) => a -> AppLaunchContextLaunchedCallback -> m SignalHandlerId onAppLaunchContextLaunched obj cb = liftIO $ connectAppLaunchContextLaunched obj cb SignalConnectBefore afterAppLaunchContextLaunched :: (GObject a, MonadIO m) => a -> AppLaunchContextLaunchedCallback -> m SignalHandlerId afterAppLaunchContextLaunched obj cb = connectAppLaunchContextLaunched obj cb SignalConnectAfter connectAppLaunchContextLaunched :: (GObject a, MonadIO m) => a -> AppLaunchContextLaunchedCallback -> SignalConnectMode -> m SignalHandlerId connectAppLaunchContextLaunched obj cb after = liftIO $ do cb' <- mkAppLaunchContextLaunchedCallback (appLaunchContextLaunchedCallbackWrapper cb) connectSignalFunPtr obj "launched" cb' after -- object Application newtype Application = Application (ForeignPtr Application) noApplication :: Maybe Application noApplication = Nothing foreign import ccall "g_application_get_type" c_g_application_get_type :: IO GType type instance ParentTypes Application = '[GObject.Object, ActionGroup, ActionMap] instance GObject Application where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_application_get_type class GObject o => ApplicationK o instance (GObject o, IsDescendantOf Application o) => ApplicationK o toApplication :: ApplicationK o => o -> IO Application toApplication = unsafeCastTo Application -- method Application::new -- method type : Constructor -- Args : [Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ApplicationFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ApplicationFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Application" -- throws : False -- Skip return : False foreign import ccall "g_application_new" g_application_new :: CString -> -- application_id : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "ApplicationFlags" IO (Ptr Application) applicationNew :: (MonadIO m) => Maybe (T.Text) -> -- application_id [ApplicationFlags] -> -- flags m Application applicationNew application_id flags = liftIO $ do maybeApplication_id <- case application_id of Nothing -> return nullPtr Just jApplication_id -> do jApplication_id' <- textToCString jApplication_id return jApplication_id' let flags' = gflagsToWord flags result <- g_application_new maybeApplication_id flags' checkUnexpectedReturnNULL "g_application_new" result result' <- (wrapObject Application) result freeMem maybeApplication_id return result' -- method Application::activate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_activate" g_application_activate :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO () applicationActivate :: (MonadIO m, ApplicationK a) => a -> -- _obj m () applicationActivate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_activate _obj' touchManagedPtr _obj return () -- method Application::add_main_option -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "long_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "short_name", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "OptionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg", argType = TInterface "GLib" "OptionArg", 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 = "arg_description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "long_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "short_name", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "OptionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg", argType = TInterface "GLib" "OptionArg", 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 = "arg_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_application_add_main_option" g_application_add_main_option :: Ptr Application -> -- _obj : TInterface "Gio" "Application" CString -> -- long_name : TBasicType TUTF8 Int8 -> -- short_name : TBasicType TInt8 CUInt -> -- flags : TInterface "GLib" "OptionFlags" CUInt -> -- arg : TInterface "GLib" "OptionArg" CString -> -- description : TBasicType TUTF8 CString -> -- arg_description : TBasicType TUTF8 IO () applicationAddMainOption :: (MonadIO m, ApplicationK a) => a -> -- _obj T.Text -> -- long_name Int8 -> -- short_name [GLib.OptionFlags] -> -- flags GLib.OptionArg -> -- arg T.Text -> -- description Maybe (T.Text) -> -- arg_description m () applicationAddMainOption _obj long_name short_name flags arg description arg_description = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj long_name' <- textToCString long_name let flags' = gflagsToWord flags let arg' = (fromIntegral . fromEnum) arg description' <- textToCString description maybeArg_description <- case arg_description of Nothing -> return nullPtr Just jArg_description -> do jArg_description' <- textToCString jArg_description return jArg_description' g_application_add_main_option _obj' long_name' short_name flags' arg' description' maybeArg_description touchManagedPtr _obj freeMem long_name' freeMem description' freeMem maybeArg_description return () -- method Application::add_main_option_entries -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TCArray True (-1) (-1) (TInterface "GLib" "OptionEntry"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TCArray True (-1) (-1) (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_application_add_main_option_entries" g_application_add_main_option_entries :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Ptr (Ptr GLib.OptionEntry) -> -- entries : TCArray True (-1) (-1) (TInterface "GLib" "OptionEntry") IO () applicationAddMainOptionEntries :: (MonadIO m, ApplicationK a) => a -> -- _obj [GLib.OptionEntry] -> -- entries m () applicationAddMainOptionEntries _obj entries = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let entries' = map unsafeManagedPtrGetPtr entries entries'' <- packZeroTerminatedPtrArray entries' g_application_add_main_option_entries _obj' entries'' touchManagedPtr _obj mapM_ touchManagedPtr entries freeMem entries'' return () -- method Application::add_option_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", 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 = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", 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 = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_add_option_group" g_application_add_option_group :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Ptr GLib.OptionGroup -> -- group : TInterface "GLib" "OptionGroup" IO () applicationAddOptionGroup :: (MonadIO m, ApplicationK a) => a -> -- _obj GLib.OptionGroup -> -- group m () applicationAddOptionGroup _obj group = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let group' = unsafeManagedPtrGetPtr group g_application_add_option_group _obj' group' touchManagedPtr _obj touchManagedPtr group return () -- method Application::bind_busy_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", 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_application_bind_busy_property" g_application_bind_busy_property :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Ptr GObject.Object -> -- object : TInterface "GObject" "Object" CString -> -- property : TBasicType TUTF8 IO () applicationBindBusyProperty :: (MonadIO m, ApplicationK a, GObject.ObjectK b) => a -> -- _obj b -> -- object T.Text -> -- property m () applicationBindBusyProperty _obj object property = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let object' = unsafeManagedPtrCastPtr object property' <- textToCString property g_application_bind_busy_property _obj' object' property' touchManagedPtr _obj touchManagedPtr object freeMem property' return () -- method Application::get_application_id -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_application_get_application_id" g_application_get_application_id :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO CString applicationGetApplicationId :: (MonadIO m, ApplicationK a) => a -> -- _obj m T.Text applicationGetApplicationId _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_application_id _obj' checkUnexpectedReturnNULL "g_application_get_application_id" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Application::get_dbus_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : False -- Skip return : False foreign import ccall "g_application_get_dbus_connection" g_application_get_dbus_connection :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO (Ptr DBusConnection) applicationGetDbusConnection :: (MonadIO m, ApplicationK a) => a -> -- _obj m DBusConnection applicationGetDbusConnection _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_dbus_connection _obj' checkUnexpectedReturnNULL "g_application_get_dbus_connection" result result' <- (newObject DBusConnection) result touchManagedPtr _obj return result' -- method Application::get_dbus_object_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_application_get_dbus_object_path" g_application_get_dbus_object_path :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO CString applicationGetDbusObjectPath :: (MonadIO m, ApplicationK a) => a -> -- _obj m T.Text applicationGetDbusObjectPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_dbus_object_path _obj' checkUnexpectedReturnNULL "g_application_get_dbus_object_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Application::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ApplicationFlags" -- throws : False -- Skip return : False foreign import ccall "g_application_get_flags" g_application_get_flags :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO CUInt applicationGetFlags :: (MonadIO m, ApplicationK a) => a -> -- _obj m [ApplicationFlags] applicationGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method Application::get_inactivity_timeout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_application_get_inactivity_timeout" g_application_get_inactivity_timeout :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO Word32 applicationGetInactivityTimeout :: (MonadIO m, ApplicationK a) => a -> -- _obj m Word32 applicationGetInactivityTimeout _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_inactivity_timeout _obj' touchManagedPtr _obj return result -- method Application::get_is_busy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_application_get_is_busy" g_application_get_is_busy :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO CInt applicationGetIsBusy :: (MonadIO m, ApplicationK a) => a -> -- _obj m Bool applicationGetIsBusy _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_is_busy _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Application::get_is_registered -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_application_get_is_registered" g_application_get_is_registered :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO CInt applicationGetIsRegistered :: (MonadIO m, ApplicationK a) => a -> -- _obj m Bool applicationGetIsRegistered _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_is_registered _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Application::get_is_remote -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_application_get_is_remote" g_application_get_is_remote :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO CInt applicationGetIsRemote :: (MonadIO m, ApplicationK a) => a -> -- _obj m Bool applicationGetIsRemote _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_is_remote _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Application::get_resource_base_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_application_get_resource_base_path" g_application_get_resource_base_path :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO CString applicationGetResourceBasePath :: (MonadIO m, ApplicationK a) => a -> -- _obj m T.Text applicationGetResourceBasePath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_get_resource_base_path _obj' checkUnexpectedReturnNULL "g_application_get_resource_base_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Application::hold -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_hold" g_application_hold :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO () applicationHold :: (MonadIO m, ApplicationK a) => a -> -- _obj m () applicationHold _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_hold _obj' touchManagedPtr _obj return () -- method Application::mark_busy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_mark_busy" g_application_mark_busy :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO () applicationMarkBusy :: (MonadIO m, ApplicationK a) => a -> -- _obj m () applicationMarkBusy _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_mark_busy _obj' touchManagedPtr _obj return () -- method Application::open -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TCArray False (-1) 2 (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_files", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "n_files", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TCArray False (-1) 2 (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", 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_application_open" g_application_open :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Ptr (Ptr File) -> -- files : TCArray False (-1) 2 (TInterface "Gio" "File") Int32 -> -- n_files : TBasicType TInt32 CString -> -- hint : TBasicType TUTF8 IO () applicationOpen :: (MonadIO m, ApplicationK a) => a -> -- _obj [File] -> -- files T.Text -> -- hint m () applicationOpen _obj files hint = liftIO $ do let n_files = fromIntegral $ length files let _obj' = unsafeManagedPtrCastPtr _obj let files' = map unsafeManagedPtrCastPtr files files'' <- packPtrArray files' hint' <- textToCString hint g_application_open _obj' files'' n_files hint' touchManagedPtr _obj mapM_ touchManagedPtr files freeMem files'' freeMem hint' return () -- method Application::quit -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_quit" g_application_quit :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO () applicationQuit :: (MonadIO m, ApplicationK a) => a -> -- _obj m () applicationQuit _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_quit _obj' touchManagedPtr _obj return () -- method Application::register -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_application_register" g_application_register :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt applicationRegister :: (MonadIO m, ApplicationK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () applicationRegister _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_application_register _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Application::release -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_release" g_application_release :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO () applicationRelease :: (MonadIO m, ApplicationK a) => a -> -- _obj m () applicationRelease _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_release _obj' touchManagedPtr _obj return () -- method Application::run -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argc", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray False (-1) 1 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "argc", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray False (-1) 1 (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_application_run" g_application_run :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Int32 -> -- argc : TBasicType TInt32 Ptr CString -> -- argv : TCArray False (-1) 1 (TBasicType TUTF8) IO Int32 applicationRun :: (MonadIO m, ApplicationK a) => a -> -- _obj Maybe ([T.Text]) -> -- argv m Int32 applicationRun _obj argv = liftIO $ do let argc = case argv of Nothing -> 0 Just jArgv -> fromIntegral $ length jArgv let _obj' = unsafeManagedPtrCastPtr _obj maybeArgv <- case argv of Nothing -> return nullPtr Just jArgv -> do jArgv' <- packUTF8CArray jArgv return jArgv' result <- g_application_run _obj' argc maybeArgv touchManagedPtr _obj (mapCArrayWithLength argc) freeMem maybeArgv freeMem maybeArgv return result -- method Application::send_notification -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notification", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notification", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_send_notification" g_application_send_notification :: Ptr Application -> -- _obj : TInterface "Gio" "Application" CString -> -- id : TBasicType TUTF8 Ptr Notification -> -- notification : TInterface "Gio" "Notification" IO () applicationSendNotification :: (MonadIO m, ApplicationK a, NotificationK b) => a -> -- _obj Maybe (T.Text) -> -- id b -> -- notification m () applicationSendNotification _obj id notification = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeId <- case id of Nothing -> return nullPtr Just jId -> do jId' <- textToCString jId return jId' let notification' = unsafeManagedPtrCastPtr notification g_application_send_notification _obj' maybeId notification' touchManagedPtr _obj touchManagedPtr notification freeMem maybeId return () -- method Application::set_action_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_group", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_group", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_set_action_group" g_application_set_action_group :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Ptr ActionGroup -> -- action_group : TInterface "Gio" "ActionGroup" IO () {-# DEPRECATED applicationSetActionGroup ["(Since version 2.32)","Use the #GActionMap interface instead. Never ever","mix use of this API with use of #GActionMap on the same @application","or things will go very badly wrong. This function is known to","introduce buggy behaviour (ie: signals not emitted on changes to the","action group), so you should really use #GActionMap instead."]#-} applicationSetActionGroup :: (MonadIO m, ApplicationK a, ActionGroupK b) => a -> -- _obj Maybe (b) -> -- action_group m () applicationSetActionGroup _obj action_group = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeAction_group <- case action_group of Nothing -> return nullPtr Just jAction_group -> do let jAction_group' = unsafeManagedPtrCastPtr jAction_group return jAction_group' g_application_set_action_group _obj' maybeAction_group touchManagedPtr _obj whenJust action_group touchManagedPtr return () -- method Application::set_application_id -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "application_id", 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_application_set_application_id" g_application_set_application_id :: Ptr Application -> -- _obj : TInterface "Gio" "Application" CString -> -- application_id : TBasicType TUTF8 IO () applicationSetApplicationId :: (MonadIO m, ApplicationK a) => a -> -- _obj Maybe (T.Text) -> -- application_id m () applicationSetApplicationId _obj application_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeApplication_id <- case application_id of Nothing -> return nullPtr Just jApplication_id -> do jApplication_id' <- textToCString jApplication_id return jApplication_id' g_application_set_application_id _obj' maybeApplication_id touchManagedPtr _obj freeMem maybeApplication_id return () -- method Application::set_default -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_set_default" g_application_set_default :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO () applicationSetDefault :: (MonadIO m, ApplicationK a) => a -> -- _obj m () applicationSetDefault _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_set_default _obj' touchManagedPtr _obj return () -- method Application::set_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ApplicationFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ApplicationFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_set_flags" g_application_set_flags :: Ptr Application -> -- _obj : TInterface "Gio" "Application" CUInt -> -- flags : TInterface "Gio" "ApplicationFlags" IO () applicationSetFlags :: (MonadIO m, ApplicationK a) => a -> -- _obj [ApplicationFlags] -> -- flags m () applicationSetFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags g_application_set_flags _obj' flags' touchManagedPtr _obj return () -- method Application::set_inactivity_timeout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inactivity_timeout", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inactivity_timeout", 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_application_set_inactivity_timeout" g_application_set_inactivity_timeout :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Word32 -> -- inactivity_timeout : TBasicType TUInt32 IO () applicationSetInactivityTimeout :: (MonadIO m, ApplicationK a) => a -> -- _obj Word32 -> -- inactivity_timeout m () applicationSetInactivityTimeout _obj inactivity_timeout = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_set_inactivity_timeout _obj' inactivity_timeout touchManagedPtr _obj return () -- method Application::set_resource_base_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "resource_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "resource_path", 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_application_set_resource_base_path" g_application_set_resource_base_path :: Ptr Application -> -- _obj : TInterface "Gio" "Application" CString -> -- resource_path : TBasicType TUTF8 IO () applicationSetResourceBasePath :: (MonadIO m, ApplicationK a) => a -> -- _obj Maybe (T.Text) -> -- resource_path m () applicationSetResourceBasePath _obj resource_path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeResource_path <- case resource_path of Nothing -> return nullPtr Just jResource_path -> do jResource_path' <- textToCString jResource_path return jResource_path' g_application_set_resource_base_path _obj' maybeResource_path touchManagedPtr _obj freeMem maybeResource_path return () -- method Application::unbind_busy_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", 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_application_unbind_busy_property" g_application_unbind_busy_property :: Ptr Application -> -- _obj : TInterface "Gio" "Application" Ptr GObject.Object -> -- object : TInterface "GObject" "Object" CString -> -- property : TBasicType TUTF8 IO () applicationUnbindBusyProperty :: (MonadIO m, ApplicationK a, GObject.ObjectK b) => a -> -- _obj b -> -- object T.Text -> -- property m () applicationUnbindBusyProperty _obj object property = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let object' = unsafeManagedPtrCastPtr object property' <- textToCString property g_application_unbind_busy_property _obj' object' property' touchManagedPtr _obj touchManagedPtr object freeMem property' return () -- method Application::unmark_busy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_application_unmark_busy" g_application_unmark_busy :: Ptr Application -> -- _obj : TInterface "Gio" "Application" IO () applicationUnmarkBusy :: (MonadIO m, ApplicationK a) => a -> -- _obj m () applicationUnmarkBusy _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_unmark_busy _obj' touchManagedPtr _obj return () -- method Application::withdraw_notification -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id", 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_application_withdraw_notification" g_application_withdraw_notification :: Ptr Application -> -- _obj : TInterface "Gio" "Application" CString -> -- id : TBasicType TUTF8 IO () applicationWithdrawNotification :: (MonadIO m, ApplicationK a) => a -> -- _obj T.Text -> -- id m () applicationWithdrawNotification _obj id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj id' <- textToCString id g_application_withdraw_notification _obj' id' touchManagedPtr _obj freeMem id' return () -- method Application::get_default -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "Application" -- throws : False -- Skip return : False foreign import ccall "g_application_get_default" g_application_get_default :: IO (Ptr Application) applicationGetDefault :: (MonadIO m) => m Application applicationGetDefault = liftIO $ do result <- g_application_get_default checkUnexpectedReturnNULL "g_application_get_default" result result' <- (newObject Application) result return result' -- method Application::id_is_valid -- method type : MemberFunction -- Args : [Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "application_id", 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_application_id_is_valid" g_application_id_is_valid :: CString -> -- application_id : TBasicType TUTF8 IO CInt applicationIdIsValid :: (MonadIO m) => T.Text -> -- application_id m Bool applicationIdIsValid application_id = liftIO $ do application_id' <- textToCString application_id result <- g_application_id_is_valid application_id' let result' = (/= 0) result freeMem application_id' return result' -- signal Application::activate type ApplicationActivateCallback = IO () noApplicationActivateCallback :: Maybe ApplicationActivateCallback noApplicationActivateCallback = Nothing type ApplicationActivateCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkApplicationActivateCallback :: ApplicationActivateCallbackC -> IO (FunPtr ApplicationActivateCallbackC) applicationActivateClosure :: ApplicationActivateCallback -> IO Closure applicationActivateClosure cb = newCClosure =<< mkApplicationActivateCallback wrapped where wrapped = applicationActivateCallbackWrapper cb applicationActivateCallbackWrapper :: ApplicationActivateCallback -> Ptr () -> Ptr () -> IO () applicationActivateCallbackWrapper _cb _ _ = do _cb onApplicationActivate :: (GObject a, MonadIO m) => a -> ApplicationActivateCallback -> m SignalHandlerId onApplicationActivate obj cb = liftIO $ connectApplicationActivate obj cb SignalConnectBefore afterApplicationActivate :: (GObject a, MonadIO m) => a -> ApplicationActivateCallback -> m SignalHandlerId afterApplicationActivate obj cb = connectApplicationActivate obj cb SignalConnectAfter connectApplicationActivate :: (GObject a, MonadIO m) => a -> ApplicationActivateCallback -> SignalConnectMode -> m SignalHandlerId connectApplicationActivate obj cb after = liftIO $ do cb' <- mkApplicationActivateCallback (applicationActivateCallbackWrapper cb) connectSignalFunPtr obj "activate" cb' after -- signal Application::command-line type ApplicationCommandLineCallback = ApplicationCommandLine -> IO Int32 noApplicationCommandLineCallback :: Maybe ApplicationCommandLineCallback noApplicationCommandLineCallback = Nothing type ApplicationCommandLineCallbackC = Ptr () -> -- object Ptr ApplicationCommandLine -> Ptr () -> -- user_data IO Int32 foreign import ccall "wrapper" mkApplicationCommandLineCallback :: ApplicationCommandLineCallbackC -> IO (FunPtr ApplicationCommandLineCallbackC) applicationCommandLineClosure :: ApplicationCommandLineCallback -> IO Closure applicationCommandLineClosure cb = newCClosure =<< mkApplicationCommandLineCallback wrapped where wrapped = applicationCommandLineCallbackWrapper cb applicationCommandLineCallbackWrapper :: ApplicationCommandLineCallback -> Ptr () -> Ptr ApplicationCommandLine -> Ptr () -> IO Int32 applicationCommandLineCallbackWrapper _cb _ command_line _ = do command_line' <- (newObject ApplicationCommandLine) command_line result <- _cb command_line' return result onApplicationCommandLine :: (GObject a, MonadIO m) => a -> ApplicationCommandLineCallback -> m SignalHandlerId onApplicationCommandLine obj cb = liftIO $ connectApplicationCommandLine obj cb SignalConnectBefore afterApplicationCommandLine :: (GObject a, MonadIO m) => a -> ApplicationCommandLineCallback -> m SignalHandlerId afterApplicationCommandLine obj cb = connectApplicationCommandLine obj cb SignalConnectAfter connectApplicationCommandLine :: (GObject a, MonadIO m) => a -> ApplicationCommandLineCallback -> SignalConnectMode -> m SignalHandlerId connectApplicationCommandLine obj cb after = liftIO $ do cb' <- mkApplicationCommandLineCallback (applicationCommandLineCallbackWrapper cb) connectSignalFunPtr obj "command-line" cb' after -- signal Application::handle-local-options type ApplicationHandleLocalOptionsCallback = GLib.VariantDict -> IO Int32 noApplicationHandleLocalOptionsCallback :: Maybe ApplicationHandleLocalOptionsCallback noApplicationHandleLocalOptionsCallback = Nothing type ApplicationHandleLocalOptionsCallbackC = Ptr () -> -- object Ptr GLib.VariantDict -> Ptr () -> -- user_data IO Int32 foreign import ccall "wrapper" mkApplicationHandleLocalOptionsCallback :: ApplicationHandleLocalOptionsCallbackC -> IO (FunPtr ApplicationHandleLocalOptionsCallbackC) applicationHandleLocalOptionsClosure :: ApplicationHandleLocalOptionsCallback -> IO Closure applicationHandleLocalOptionsClosure cb = newCClosure =<< mkApplicationHandleLocalOptionsCallback wrapped where wrapped = applicationHandleLocalOptionsCallbackWrapper cb applicationHandleLocalOptionsCallbackWrapper :: ApplicationHandleLocalOptionsCallback -> Ptr () -> Ptr GLib.VariantDict -> Ptr () -> IO Int32 applicationHandleLocalOptionsCallbackWrapper _cb _ options _ = do options' <- (newBoxed GLib.VariantDict) options result <- _cb options' return result onApplicationHandleLocalOptions :: (GObject a, MonadIO m) => a -> ApplicationHandleLocalOptionsCallback -> m SignalHandlerId onApplicationHandleLocalOptions obj cb = liftIO $ connectApplicationHandleLocalOptions obj cb SignalConnectBefore afterApplicationHandleLocalOptions :: (GObject a, MonadIO m) => a -> ApplicationHandleLocalOptionsCallback -> m SignalHandlerId afterApplicationHandleLocalOptions obj cb = connectApplicationHandleLocalOptions obj cb SignalConnectAfter connectApplicationHandleLocalOptions :: (GObject a, MonadIO m) => a -> ApplicationHandleLocalOptionsCallback -> SignalConnectMode -> m SignalHandlerId connectApplicationHandleLocalOptions obj cb after = liftIO $ do cb' <- mkApplicationHandleLocalOptionsCallback (applicationHandleLocalOptionsCallbackWrapper cb) connectSignalFunPtr obj "handle-local-options" cb' after -- signal Application::open type ApplicationOpenCallback = [File] -> T.Text -> IO () noApplicationOpenCallback :: Maybe ApplicationOpenCallback noApplicationOpenCallback = Nothing type ApplicationOpenCallbackC = Ptr () -> -- object Ptr (Ptr File) -> Int32 -> CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkApplicationOpenCallback :: ApplicationOpenCallbackC -> IO (FunPtr ApplicationOpenCallbackC) applicationOpenClosure :: ApplicationOpenCallback -> IO Closure applicationOpenClosure cb = newCClosure =<< mkApplicationOpenCallback wrapped where wrapped = applicationOpenCallbackWrapper cb applicationOpenCallbackWrapper :: ApplicationOpenCallback -> Ptr () -> Ptr (Ptr File) -> Int32 -> CString -> Ptr () -> IO () applicationOpenCallbackWrapper _cb _ files n_files hint _ = do files' <- (unpackPtrArrayWithLength n_files) files files'' <- mapM (newObject File) files' hint' <- cstringToText hint _cb files'' hint' onApplicationOpen :: (GObject a, MonadIO m) => a -> ApplicationOpenCallback -> m SignalHandlerId onApplicationOpen obj cb = liftIO $ connectApplicationOpen obj cb SignalConnectBefore afterApplicationOpen :: (GObject a, MonadIO m) => a -> ApplicationOpenCallback -> m SignalHandlerId afterApplicationOpen obj cb = connectApplicationOpen obj cb SignalConnectAfter connectApplicationOpen :: (GObject a, MonadIO m) => a -> ApplicationOpenCallback -> SignalConnectMode -> m SignalHandlerId connectApplicationOpen obj cb after = liftIO $ do cb' <- mkApplicationOpenCallback (applicationOpenCallbackWrapper cb) connectSignalFunPtr obj "open" cb' after -- signal Application::shutdown type ApplicationShutdownCallback = IO () noApplicationShutdownCallback :: Maybe ApplicationShutdownCallback noApplicationShutdownCallback = Nothing type ApplicationShutdownCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkApplicationShutdownCallback :: ApplicationShutdownCallbackC -> IO (FunPtr ApplicationShutdownCallbackC) applicationShutdownClosure :: ApplicationShutdownCallback -> IO Closure applicationShutdownClosure cb = newCClosure =<< mkApplicationShutdownCallback wrapped where wrapped = applicationShutdownCallbackWrapper cb applicationShutdownCallbackWrapper :: ApplicationShutdownCallback -> Ptr () -> Ptr () -> IO () applicationShutdownCallbackWrapper _cb _ _ = do _cb onApplicationShutdown :: (GObject a, MonadIO m) => a -> ApplicationShutdownCallback -> m SignalHandlerId onApplicationShutdown obj cb = liftIO $ connectApplicationShutdown obj cb SignalConnectBefore afterApplicationShutdown :: (GObject a, MonadIO m) => a -> ApplicationShutdownCallback -> m SignalHandlerId afterApplicationShutdown obj cb = connectApplicationShutdown obj cb SignalConnectAfter connectApplicationShutdown :: (GObject a, MonadIO m) => a -> ApplicationShutdownCallback -> SignalConnectMode -> m SignalHandlerId connectApplicationShutdown obj cb after = liftIO $ do cb' <- mkApplicationShutdownCallback (applicationShutdownCallbackWrapper cb) connectSignalFunPtr obj "shutdown" cb' after -- signal Application::startup type ApplicationStartupCallback = IO () noApplicationStartupCallback :: Maybe ApplicationStartupCallback noApplicationStartupCallback = Nothing type ApplicationStartupCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkApplicationStartupCallback :: ApplicationStartupCallbackC -> IO (FunPtr ApplicationStartupCallbackC) applicationStartupClosure :: ApplicationStartupCallback -> IO Closure applicationStartupClosure cb = newCClosure =<< mkApplicationStartupCallback wrapped where wrapped = applicationStartupCallbackWrapper cb applicationStartupCallbackWrapper :: ApplicationStartupCallback -> Ptr () -> Ptr () -> IO () applicationStartupCallbackWrapper _cb _ _ = do _cb onApplicationStartup :: (GObject a, MonadIO m) => a -> ApplicationStartupCallback -> m SignalHandlerId onApplicationStartup obj cb = liftIO $ connectApplicationStartup obj cb SignalConnectBefore afterApplicationStartup :: (GObject a, MonadIO m) => a -> ApplicationStartupCallback -> m SignalHandlerId afterApplicationStartup obj cb = connectApplicationStartup obj cb SignalConnectAfter connectApplicationStartup :: (GObject a, MonadIO m) => a -> ApplicationStartupCallback -> SignalConnectMode -> m SignalHandlerId connectApplicationStartup obj cb after = liftIO $ do cb' <- mkApplicationStartupCallback (applicationStartupCallbackWrapper cb) connectSignalFunPtr obj "startup" cb' after -- object ApplicationCommandLine newtype ApplicationCommandLine = ApplicationCommandLine (ForeignPtr ApplicationCommandLine) noApplicationCommandLine :: Maybe ApplicationCommandLine noApplicationCommandLine = Nothing foreign import ccall "g_application_command_line_get_type" c_g_application_command_line_get_type :: IO GType type instance ParentTypes ApplicationCommandLine = '[GObject.Object] instance GObject ApplicationCommandLine where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_application_command_line_get_type class GObject o => ApplicationCommandLineK o instance (GObject o, IsDescendantOf ApplicationCommandLine o) => ApplicationCommandLineK o toApplicationCommandLine :: ApplicationCommandLineK o => o -> IO ApplicationCommandLine toApplicationCommandLine = unsafeCastTo ApplicationCommandLine -- method ApplicationCommandLine::create_file_for_arg -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_application_command_line_create_file_for_arg" g_application_command_line_create_file_for_arg :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" CString -> -- arg : TBasicType TUTF8 IO (Ptr File) applicationCommandLineCreateFileForArg :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj T.Text -> -- arg m File applicationCommandLineCreateFileForArg _obj arg = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj arg' <- textToCString arg result <- g_application_command_line_create_file_for_arg _obj' arg' checkUnexpectedReturnNULL "g_application_command_line_create_file_for_arg" result result' <- (wrapObject File) result touchManagedPtr _obj freeMem arg' return result' -- method ApplicationCommandLine::get_arguments -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argc", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "argc", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", 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_application_command_line_get_arguments" g_application_command_line_get_arguments :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" Ptr Int32 -> -- argc : TBasicType TInt32 IO (Ptr CString) applicationCommandLineGetArguments :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj m [T.Text] applicationCommandLineGetArguments _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj argc <- allocMem :: IO (Ptr Int32) result <- g_application_command_line_get_arguments _obj' argc argc' <- peek argc checkUnexpectedReturnNULL "g_application_command_line_get_arguments" result result' <- (unpackUTF8CArrayWithLength argc') result (mapCArrayWithLength argc') freeMem result freeMem result touchManagedPtr _obj freeMem argc return result' -- method ApplicationCommandLine::get_cwd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_application_command_line_get_cwd" g_application_command_line_get_cwd :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" IO CString applicationCommandLineGetCwd :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj m T.Text applicationCommandLineGetCwd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_command_line_get_cwd _obj' checkUnexpectedReturnNULL "g_application_command_line_get_cwd" result result' <- cstringToText result touchManagedPtr _obj return result' -- method ApplicationCommandLine::get_environ -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", 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_application_command_line_get_environ" g_application_command_line_get_environ :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" IO (Ptr CString) applicationCommandLineGetEnviron :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj m [T.Text] applicationCommandLineGetEnviron _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_command_line_get_environ _obj' checkUnexpectedReturnNULL "g_application_command_line_get_environ" result result' <- unpackZeroTerminatedUTF8CArray result touchManagedPtr _obj return result' -- method ApplicationCommandLine::get_exit_status -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_application_command_line_get_exit_status" g_application_command_line_get_exit_status :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" IO Int32 applicationCommandLineGetExitStatus :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj m Int32 applicationCommandLineGetExitStatus _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_command_line_get_exit_status _obj' touchManagedPtr _obj return result -- method ApplicationCommandLine::get_is_remote -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_application_command_line_get_is_remote" g_application_command_line_get_is_remote :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" IO CInt applicationCommandLineGetIsRemote :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj m Bool applicationCommandLineGetIsRemote _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_command_line_get_is_remote _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method ApplicationCommandLine::get_options_dict -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", 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_application_command_line_get_options_dict" g_application_command_line_get_options_dict :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" IO (Ptr GLib.VariantDict) applicationCommandLineGetOptionsDict :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj m GLib.VariantDict applicationCommandLineGetOptionsDict _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_command_line_get_options_dict _obj' checkUnexpectedReturnNULL "g_application_command_line_get_options_dict" result result' <- (newBoxed GLib.VariantDict) result touchManagedPtr _obj return result' -- method ApplicationCommandLine::get_platform_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_application_command_line_get_platform_data" g_application_command_line_get_platform_data :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" IO (Ptr GVariant) applicationCommandLineGetPlatformData :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj m GVariant applicationCommandLineGetPlatformData _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_command_line_get_platform_data _obj' checkUnexpectedReturnNULL "g_application_command_line_get_platform_data" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method ApplicationCommandLine::get_stdin -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : False -- Skip return : False foreign import ccall "g_application_command_line_get_stdin" g_application_command_line_get_stdin :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" IO (Ptr InputStream) applicationCommandLineGetStdin :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj m InputStream applicationCommandLineGetStdin _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_application_command_line_get_stdin _obj' checkUnexpectedReturnNULL "g_application_command_line_get_stdin" result result' <- (wrapObject InputStream) result touchManagedPtr _obj return result' -- method ApplicationCommandLine::getenv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", 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 "Gio" "ApplicationCommandLine", 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_application_command_line_getenv" g_application_command_line_getenv :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" CString -> -- name : TBasicType TUTF8 IO CString applicationCommandLineGetenv :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj T.Text -> -- name m T.Text applicationCommandLineGetenv _obj name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- textToCString name result <- g_application_command_line_getenv _obj' name' checkUnexpectedReturnNULL "g_application_command_line_getenv" result result' <- cstringToText result touchManagedPtr _obj freeMem name' return result' -- method ApplicationCommandLine::set_exit_status -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exit_status", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ApplicationCommandLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exit_status", 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_application_command_line_set_exit_status" g_application_command_line_set_exit_status :: Ptr ApplicationCommandLine -> -- _obj : TInterface "Gio" "ApplicationCommandLine" Int32 -> -- exit_status : TBasicType TInt32 IO () applicationCommandLineSetExitStatus :: (MonadIO m, ApplicationCommandLineK a) => a -> -- _obj Int32 -> -- exit_status m () applicationCommandLineSetExitStatus _obj exit_status = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_application_command_line_set_exit_status _obj' exit_status touchManagedPtr _obj return () -- Flags ApplicationFlags data ApplicationFlags = ApplicationFlagsFlagsNone | ApplicationFlagsIsService | ApplicationFlagsIsLauncher | ApplicationFlagsHandlesOpen | ApplicationFlagsHandlesCommandLine | ApplicationFlagsSendEnvironment | ApplicationFlagsNonUnique | AnotherApplicationFlags Int deriving (Show, Eq) instance Enum ApplicationFlags where fromEnum ApplicationFlagsFlagsNone = 0 fromEnum ApplicationFlagsIsService = 1 fromEnum ApplicationFlagsIsLauncher = 2 fromEnum ApplicationFlagsHandlesOpen = 4 fromEnum ApplicationFlagsHandlesCommandLine = 8 fromEnum ApplicationFlagsSendEnvironment = 16 fromEnum ApplicationFlagsNonUnique = 32 fromEnum (AnotherApplicationFlags k) = k toEnum 0 = ApplicationFlagsFlagsNone toEnum 1 = ApplicationFlagsIsService toEnum 2 = ApplicationFlagsIsLauncher toEnum 4 = ApplicationFlagsHandlesOpen toEnum 8 = ApplicationFlagsHandlesCommandLine toEnum 16 = ApplicationFlagsSendEnvironment toEnum 32 = ApplicationFlagsNonUnique toEnum k = AnotherApplicationFlags k foreign import ccall "g_application_flags_get_type" c_g_application_flags_get_type :: IO GType instance BoxedEnum ApplicationFlags where boxedEnumType _ = c_g_application_flags_get_type instance IsGFlag ApplicationFlags -- Flags AskPasswordFlags data AskPasswordFlags = AskPasswordFlagsNeedPassword | AskPasswordFlagsNeedUsername | AskPasswordFlagsNeedDomain | AskPasswordFlagsSavingSupported | AskPasswordFlagsAnonymousSupported | AnotherAskPasswordFlags Int deriving (Show, Eq) instance Enum AskPasswordFlags where fromEnum AskPasswordFlagsNeedPassword = 1 fromEnum AskPasswordFlagsNeedUsername = 2 fromEnum AskPasswordFlagsNeedDomain = 4 fromEnum AskPasswordFlagsSavingSupported = 8 fromEnum AskPasswordFlagsAnonymousSupported = 16 fromEnum (AnotherAskPasswordFlags k) = k toEnum 1 = AskPasswordFlagsNeedPassword toEnum 2 = AskPasswordFlagsNeedUsername toEnum 4 = AskPasswordFlagsNeedDomain toEnum 8 = AskPasswordFlagsSavingSupported toEnum 16 = AskPasswordFlagsAnonymousSupported toEnum k = AnotherAskPasswordFlags k foreign import ccall "g_ask_password_flags_get_type" c_g_ask_password_flags_get_type :: IO GType instance BoxedEnum AskPasswordFlags where boxedEnumType _ = c_g_ask_password_flags_get_type instance IsGFlag AskPasswordFlags -- interface AsyncInitable newtype AsyncInitable = AsyncInitable (ForeignPtr AsyncInitable) noAsyncInitable :: Maybe AsyncInitable noAsyncInitable = Nothing foreign import ccall "g_async_initable_get_type" c_g_async_initable_get_type :: IO GType type instance ParentTypes AsyncInitable = '[GObject.Object] instance GObject AsyncInitable where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_async_initable_get_type class GObject o => AsyncInitableK o instance (GObject o, IsDescendantOf AsyncInitable o) => AsyncInitableK o toAsyncInitable :: AsyncInitableK o => o -> IO AsyncInitable toAsyncInitable = unsafeCastTo AsyncInitable -- method AsyncInitable::init_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncInitable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "AsyncInitable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_initable_init_async" g_async_initable_init_async :: Ptr AsyncInitable -> -- _obj : TInterface "Gio" "AsyncInitable" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () asyncInitableInitAsync :: (MonadIO m, AsyncInitableK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () asyncInitableInitAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_async_initable_init_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method AsyncInitable::init_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncInitable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncInitable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_async_initable_init_finish" g_async_initable_init_finish :: Ptr AsyncInitable -> -- _obj : TInterface "Gio" "AsyncInitable" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt asyncInitableInitFinish :: (MonadIO m, AsyncInitableK a, AsyncResultK b) => a -> -- _obj b -> -- res m () asyncInitableInitFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do _ <- propagateGError $ g_async_initable_init_finish _obj' res' touchManagedPtr _obj touchManagedPtr res return () ) (do return () ) -- method AsyncInitable::new_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncInitable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncInitable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : True -- Skip return : False foreign import ccall "g_async_initable_new_finish" g_async_initable_new_finish :: Ptr AsyncInitable -> -- _obj : TInterface "Gio" "AsyncInitable" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr GObject.Object) asyncInitableNewFinish :: (MonadIO m, AsyncInitableK a, AsyncResultK b) => a -> -- _obj b -> -- res m GObject.Object asyncInitableNewFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_async_initable_new_finish _obj' res' checkUnexpectedReturnNULL "g_async_initable_new_finish" result result' <- (wrapObject GObject.Object) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- callback AsyncReadyCallback asyncReadyCallbackClosure :: AsyncReadyCallback -> IO Closure asyncReadyCallbackClosure cb = newCClosure =<< mkAsyncReadyCallback wrapped where wrapped = asyncReadyCallbackWrapper Nothing cb type AsyncReadyCallbackC = Ptr GObject.Object -> Ptr AsyncResult -> Ptr () -> IO () foreign import ccall "wrapper" mkAsyncReadyCallback :: AsyncReadyCallbackC -> IO (FunPtr AsyncReadyCallbackC) type AsyncReadyCallback = GObject.Object -> AsyncResult -> IO () noAsyncReadyCallback :: Maybe AsyncReadyCallback noAsyncReadyCallback = Nothing asyncReadyCallbackWrapper :: Maybe (Ptr (FunPtr (AsyncReadyCallbackC))) -> AsyncReadyCallback -> Ptr GObject.Object -> Ptr AsyncResult -> Ptr () -> IO () asyncReadyCallbackWrapper funptrptr _cb source_object res _ = do source_object' <- (newObject GObject.Object) source_object res' <- (newObject AsyncResult) res _cb source_object' res' maybeReleaseFunPtr funptrptr -- interface AsyncResult newtype AsyncResult = AsyncResult (ForeignPtr AsyncResult) noAsyncResult :: Maybe AsyncResult noAsyncResult = Nothing foreign import ccall "g_async_result_get_type" c_g_async_result_get_type :: IO GType type instance ParentTypes AsyncResult = '[GObject.Object] instance GObject AsyncResult where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_async_result_get_type class GObject o => AsyncResultK o instance (GObject o, IsDescendantOf AsyncResult o) => AsyncResultK o toAsyncResult :: AsyncResultK o => o -> IO AsyncResult toAsyncResult = unsafeCastTo AsyncResult -- method AsyncResult::get_source_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_async_result_get_source_object" g_async_result_get_source_object :: Ptr AsyncResult -> -- _obj : TInterface "Gio" "AsyncResult" IO (Ptr GObject.Object) asyncResultGetSourceObject :: (MonadIO m, AsyncResultK a) => a -> -- _obj m GObject.Object asyncResultGetSourceObject _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_async_result_get_source_object _obj' checkUnexpectedReturnNULL "g_async_result_get_source_object" result result' <- (wrapObject GObject.Object) result touchManagedPtr _obj return result' -- method AsyncResult::get_user_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncResult", 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_result_get_user_data" g_async_result_get_user_data :: Ptr AsyncResult -> -- _obj : TInterface "Gio" "AsyncResult" IO () asyncResultGetUserData :: (MonadIO m, AsyncResultK a) => a -> -- _obj m () asyncResultGetUserData _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_async_result_get_user_data _obj' touchManagedPtr _obj return () -- method AsyncResult::is_tagged -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_tag", 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_async_result_is_tagged" g_async_result_is_tagged :: Ptr AsyncResult -> -- _obj : TInterface "Gio" "AsyncResult" Ptr () -> -- source_tag : TBasicType TVoid IO CInt asyncResultIsTagged :: (MonadIO m, AsyncResultK a) => a -> -- _obj Ptr () -> -- source_tag m Bool asyncResultIsTagged _obj source_tag = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_async_result_is_tagged _obj' source_tag let result' = (/= 0) result touchManagedPtr _obj return result' -- method AsyncResult::legacy_propagate_error -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_async_result_legacy_propagate_error" g_async_result_legacy_propagate_error :: Ptr AsyncResult -> -- _obj : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt asyncResultLegacyPropagateError :: (MonadIO m, AsyncResultK a) => a -> -- _obj m () asyncResultLegacyPropagateError _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_async_result_legacy_propagate_error _obj' touchManagedPtr _obj return () ) (do return () ) -- object BufferedInputStream newtype BufferedInputStream = BufferedInputStream (ForeignPtr BufferedInputStream) noBufferedInputStream :: Maybe BufferedInputStream noBufferedInputStream = Nothing foreign import ccall "g_buffered_input_stream_get_type" c_g_buffered_input_stream_get_type :: IO GType type instance ParentTypes BufferedInputStream = '[FilterInputStream, InputStream, GObject.Object, Seekable] instance GObject BufferedInputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_buffered_input_stream_get_type class GObject o => BufferedInputStreamK o instance (GObject o, IsDescendantOf BufferedInputStream o) => BufferedInputStreamK o toBufferedInputStream :: BufferedInputStreamK o => o -> IO BufferedInputStream toBufferedInputStream = unsafeCastTo BufferedInputStream -- method BufferedInputStream::new -- method type : Constructor -- Args : [Arg {argName = "base_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "BufferedInputStream" -- throws : False -- Skip return : False foreign import ccall "g_buffered_input_stream_new" g_buffered_input_stream_new :: Ptr InputStream -> -- base_stream : TInterface "Gio" "InputStream" IO (Ptr BufferedInputStream) bufferedInputStreamNew :: (MonadIO m, InputStreamK a) => a -> -- base_stream m BufferedInputStream bufferedInputStreamNew base_stream = liftIO $ do let base_stream' = unsafeManagedPtrCastPtr base_stream result <- g_buffered_input_stream_new base_stream' checkUnexpectedReturnNULL "g_buffered_input_stream_new" result result' <- (wrapObject BufferedInputStream) result touchManagedPtr base_stream return result' -- method BufferedInputStream::new_sized -- method type : Constructor -- Args : [Arg {argName = "base_stream", argType = TInterface "Gio" "InputStream", 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 = "base_stream", argType = TInterface "Gio" "InputStream", 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 : TInterface "Gio" "BufferedInputStream" -- throws : False -- Skip return : False foreign import ccall "g_buffered_input_stream_new_sized" g_buffered_input_stream_new_sized :: Ptr InputStream -> -- base_stream : TInterface "Gio" "InputStream" Word64 -> -- size : TBasicType TUInt64 IO (Ptr BufferedInputStream) bufferedInputStreamNewSized :: (MonadIO m, InputStreamK a) => a -> -- base_stream Word64 -> -- size m BufferedInputStream bufferedInputStreamNewSized base_stream size = liftIO $ do let base_stream' = unsafeManagedPtrCastPtr base_stream result <- g_buffered_input_stream_new_sized base_stream' size checkUnexpectedReturnNULL "g_buffered_input_stream_new_sized" result result' <- (wrapObject BufferedInputStream) result touchManagedPtr base_stream return result' -- method BufferedInputStream::fill -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_buffered_input_stream_fill" g_buffered_input_stream_fill :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" Int64 -> -- count : TBasicType TInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 bufferedInputStreamFill :: (MonadIO m, BufferedInputStreamK a, CancellableK b) => a -> -- _obj Int64 -> -- count Maybe (b) -> -- cancellable m Int64 bufferedInputStreamFill _obj count cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_buffered_input_stream_fill _obj' count maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method BufferedInputStream::fill_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_buffered_input_stream_fill_async" g_buffered_input_stream_fill_async :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" Int64 -> -- count : TBasicType TInt64 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () bufferedInputStreamFillAsync :: (MonadIO m, BufferedInputStreamK a, CancellableK b) => a -> -- _obj Int64 -> -- count Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () bufferedInputStreamFillAsync _obj count io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_buffered_input_stream_fill_async _obj' count io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method BufferedInputStream::fill_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_buffered_input_stream_fill_finish" g_buffered_input_stream_fill_finish :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO Int64 bufferedInputStreamFillFinish :: (MonadIO m, BufferedInputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m Int64 bufferedInputStreamFillFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_buffered_input_stream_fill_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return result ) (do return () ) -- method BufferedInputStream::get_available -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_buffered_input_stream_get_available" g_buffered_input_stream_get_available :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" IO Word64 bufferedInputStreamGetAvailable :: (MonadIO m, BufferedInputStreamK a) => a -> -- _obj m Word64 bufferedInputStreamGetAvailable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_buffered_input_stream_get_available _obj' touchManagedPtr _obj return result -- method BufferedInputStream::get_buffer_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_buffered_input_stream_get_buffer_size" g_buffered_input_stream_get_buffer_size :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" IO Word64 bufferedInputStreamGetBufferSize :: (MonadIO m, BufferedInputStreamK a) => a -> -- _obj m Word64 bufferedInputStreamGetBufferSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_buffered_input_stream_get_buffer_size _obj' touchManagedPtr _obj return result -- method BufferedInputStream::peek -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 3 (TBasicType TUInt8), 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 = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 3 (TBasicType TUInt8), 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}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_buffered_input_stream_peek" g_buffered_input_stream_peek :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 3 (TBasicType TUInt8) Word64 -> -- offset : TBasicType TUInt64 Word64 -> -- count : TBasicType TUInt64 IO Word64 bufferedInputStreamPeek :: (MonadIO m, BufferedInputStreamK a) => a -> -- _obj ByteString -> -- buffer Word64 -> -- offset m Word64 bufferedInputStreamPeek _obj buffer offset = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer result <- g_buffered_input_stream_peek _obj' buffer' offset count touchManagedPtr _obj freeMem buffer' return result -- method BufferedInputStream::peek_buffer -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", 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_buffered_input_stream_peek_buffer" g_buffered_input_stream_peek_buffer :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" Ptr Word64 -> -- count : TBasicType TUInt64 IO (Ptr Word8) bufferedInputStreamPeekBuffer :: (MonadIO m, BufferedInputStreamK a) => a -> -- _obj m ByteString bufferedInputStreamPeekBuffer _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj count <- allocMem :: IO (Ptr Word64) result <- g_buffered_input_stream_peek_buffer _obj' count count' <- peek count checkUnexpectedReturnNULL "g_buffered_input_stream_peek_buffer" result result' <- (unpackByteStringWithLength count') result touchManagedPtr _obj freeMem count return result' -- method BufferedInputStream::read_byte -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_buffered_input_stream_read_byte" g_buffered_input_stream_read_byte :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int32 bufferedInputStreamReadByte :: (MonadIO m, BufferedInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Int32 bufferedInputStreamReadByte _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_buffered_input_stream_read_byte _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method BufferedInputStream::set_buffer_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedInputStream", 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 "Gio" "BufferedInputStream", 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_buffered_input_stream_set_buffer_size" g_buffered_input_stream_set_buffer_size :: Ptr BufferedInputStream -> -- _obj : TInterface "Gio" "BufferedInputStream" Word64 -> -- size : TBasicType TUInt64 IO () bufferedInputStreamSetBufferSize :: (MonadIO m, BufferedInputStreamK a) => a -> -- _obj Word64 -> -- size m () bufferedInputStreamSetBufferSize _obj size = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_buffered_input_stream_set_buffer_size _obj' size touchManagedPtr _obj return () -- object BufferedOutputStream newtype BufferedOutputStream = BufferedOutputStream (ForeignPtr BufferedOutputStream) noBufferedOutputStream :: Maybe BufferedOutputStream noBufferedOutputStream = Nothing foreign import ccall "g_buffered_output_stream_get_type" c_g_buffered_output_stream_get_type :: IO GType type instance ParentTypes BufferedOutputStream = '[FilterOutputStream, OutputStream, GObject.Object, Seekable] instance GObject BufferedOutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_buffered_output_stream_get_type class GObject o => BufferedOutputStreamK o instance (GObject o, IsDescendantOf BufferedOutputStream o) => BufferedOutputStreamK o toBufferedOutputStream :: BufferedOutputStreamK o => o -> IO BufferedOutputStream toBufferedOutputStream = unsafeCastTo BufferedOutputStream -- method BufferedOutputStream::new -- method type : Constructor -- Args : [Arg {argName = "base_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "BufferedOutputStream" -- throws : False -- Skip return : False foreign import ccall "g_buffered_output_stream_new" g_buffered_output_stream_new :: Ptr OutputStream -> -- base_stream : TInterface "Gio" "OutputStream" IO (Ptr BufferedOutputStream) bufferedOutputStreamNew :: (MonadIO m, OutputStreamK a) => a -> -- base_stream m BufferedOutputStream bufferedOutputStreamNew base_stream = liftIO $ do let base_stream' = unsafeManagedPtrCastPtr base_stream result <- g_buffered_output_stream_new base_stream' checkUnexpectedReturnNULL "g_buffered_output_stream_new" result result' <- (wrapObject BufferedOutputStream) result touchManagedPtr base_stream return result' -- method BufferedOutputStream::new_sized -- method type : Constructor -- Args : [Arg {argName = "base_stream", argType = TInterface "Gio" "OutputStream", 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 = "base_stream", argType = TInterface "Gio" "OutputStream", 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 : TInterface "Gio" "BufferedOutputStream" -- throws : False -- Skip return : False foreign import ccall "g_buffered_output_stream_new_sized" g_buffered_output_stream_new_sized :: Ptr OutputStream -> -- base_stream : TInterface "Gio" "OutputStream" Word64 -> -- size : TBasicType TUInt64 IO (Ptr BufferedOutputStream) bufferedOutputStreamNewSized :: (MonadIO m, OutputStreamK a) => a -> -- base_stream Word64 -> -- size m BufferedOutputStream bufferedOutputStreamNewSized base_stream size = liftIO $ do let base_stream' = unsafeManagedPtrCastPtr base_stream result <- g_buffered_output_stream_new_sized base_stream' size checkUnexpectedReturnNULL "g_buffered_output_stream_new_sized" result result' <- (wrapObject BufferedOutputStream) result touchManagedPtr base_stream return result' -- method BufferedOutputStream::get_auto_grow -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_buffered_output_stream_get_auto_grow" g_buffered_output_stream_get_auto_grow :: Ptr BufferedOutputStream -> -- _obj : TInterface "Gio" "BufferedOutputStream" IO CInt bufferedOutputStreamGetAutoGrow :: (MonadIO m, BufferedOutputStreamK a) => a -> -- _obj m Bool bufferedOutputStreamGetAutoGrow _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_buffered_output_stream_get_auto_grow _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method BufferedOutputStream::get_buffer_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_buffered_output_stream_get_buffer_size" g_buffered_output_stream_get_buffer_size :: Ptr BufferedOutputStream -> -- _obj : TInterface "Gio" "BufferedOutputStream" IO Word64 bufferedOutputStreamGetBufferSize :: (MonadIO m, BufferedOutputStreamK a) => a -> -- _obj m Word64 bufferedOutputStreamGetBufferSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_buffered_output_stream_get_buffer_size _obj' touchManagedPtr _obj return result -- method BufferedOutputStream::set_auto_grow -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "auto_grow", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "auto_grow", 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_buffered_output_stream_set_auto_grow" g_buffered_output_stream_set_auto_grow :: Ptr BufferedOutputStream -> -- _obj : TInterface "Gio" "BufferedOutputStream" CInt -> -- auto_grow : TBasicType TBoolean IO () bufferedOutputStreamSetAutoGrow :: (MonadIO m, BufferedOutputStreamK a) => a -> -- _obj Bool -> -- auto_grow m () bufferedOutputStreamSetAutoGrow _obj auto_grow = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let auto_grow' = (fromIntegral . fromEnum) auto_grow g_buffered_output_stream_set_auto_grow _obj' auto_grow' touchManagedPtr _obj return () -- method BufferedOutputStream::set_buffer_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BufferedOutputStream", 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 "Gio" "BufferedOutputStream", 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_buffered_output_stream_set_buffer_size" g_buffered_output_stream_set_buffer_size :: Ptr BufferedOutputStream -> -- _obj : TInterface "Gio" "BufferedOutputStream" Word64 -> -- size : TBasicType TUInt64 IO () bufferedOutputStreamSetBufferSize :: (MonadIO m, BufferedOutputStreamK a) => a -> -- _obj Word64 -> -- size m () bufferedOutputStreamSetBufferSize _obj size = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_buffered_output_stream_set_buffer_size _obj' size touchManagedPtr _obj return () -- callback BusAcquiredCallback busAcquiredCallbackClosure :: BusAcquiredCallback -> IO Closure busAcquiredCallbackClosure cb = newCClosure =<< mkBusAcquiredCallback wrapped where wrapped = busAcquiredCallbackWrapper Nothing cb type BusAcquiredCallbackC = Ptr DBusConnection -> CString -> Ptr () -> IO () foreign import ccall "wrapper" mkBusAcquiredCallback :: BusAcquiredCallbackC -> IO (FunPtr BusAcquiredCallbackC) type BusAcquiredCallback = DBusConnection -> T.Text -> IO () noBusAcquiredCallback :: Maybe BusAcquiredCallback noBusAcquiredCallback = Nothing busAcquiredCallbackWrapper :: Maybe (Ptr (FunPtr (BusAcquiredCallbackC))) -> BusAcquiredCallback -> Ptr DBusConnection -> CString -> Ptr () -> IO () busAcquiredCallbackWrapper funptrptr _cb connection name _ = do connection' <- (newObject DBusConnection) connection name' <- cstringToText name _cb connection' name' maybeReleaseFunPtr funptrptr -- callback BusNameAcquiredCallback busNameAcquiredCallbackClosure :: BusNameAcquiredCallback -> IO Closure busNameAcquiredCallbackClosure cb = newCClosure =<< mkBusNameAcquiredCallback wrapped where wrapped = busNameAcquiredCallbackWrapper Nothing cb type BusNameAcquiredCallbackC = Ptr DBusConnection -> CString -> Ptr () -> IO () foreign import ccall "wrapper" mkBusNameAcquiredCallback :: BusNameAcquiredCallbackC -> IO (FunPtr BusNameAcquiredCallbackC) type BusNameAcquiredCallback = DBusConnection -> T.Text -> IO () noBusNameAcquiredCallback :: Maybe BusNameAcquiredCallback noBusNameAcquiredCallback = Nothing busNameAcquiredCallbackWrapper :: Maybe (Ptr (FunPtr (BusNameAcquiredCallbackC))) -> BusNameAcquiredCallback -> Ptr DBusConnection -> CString -> Ptr () -> IO () busNameAcquiredCallbackWrapper funptrptr _cb connection name _ = do connection' <- (newObject DBusConnection) connection name' <- cstringToText name _cb connection' name' maybeReleaseFunPtr funptrptr -- callback BusNameAppearedCallback busNameAppearedCallbackClosure :: BusNameAppearedCallback -> IO Closure busNameAppearedCallbackClosure cb = newCClosure =<< mkBusNameAppearedCallback wrapped where wrapped = busNameAppearedCallbackWrapper Nothing cb type BusNameAppearedCallbackC = Ptr DBusConnection -> CString -> CString -> Ptr () -> IO () foreign import ccall "wrapper" mkBusNameAppearedCallback :: BusNameAppearedCallbackC -> IO (FunPtr BusNameAppearedCallbackC) type BusNameAppearedCallback = DBusConnection -> T.Text -> T.Text -> IO () noBusNameAppearedCallback :: Maybe BusNameAppearedCallback noBusNameAppearedCallback = Nothing busNameAppearedCallbackWrapper :: Maybe (Ptr (FunPtr (BusNameAppearedCallbackC))) -> BusNameAppearedCallback -> Ptr DBusConnection -> CString -> CString -> Ptr () -> IO () busNameAppearedCallbackWrapper funptrptr _cb connection name name_owner _ = do connection' <- (newObject DBusConnection) connection name' <- cstringToText name name_owner' <- cstringToText name_owner _cb connection' name' name_owner' maybeReleaseFunPtr funptrptr -- callback BusNameLostCallback busNameLostCallbackClosure :: BusNameLostCallback -> IO Closure busNameLostCallbackClosure cb = newCClosure =<< mkBusNameLostCallback wrapped where wrapped = busNameLostCallbackWrapper Nothing cb type BusNameLostCallbackC = Ptr DBusConnection -> CString -> Ptr () -> IO () foreign import ccall "wrapper" mkBusNameLostCallback :: BusNameLostCallbackC -> IO (FunPtr BusNameLostCallbackC) type BusNameLostCallback = DBusConnection -> T.Text -> IO () noBusNameLostCallback :: Maybe BusNameLostCallback noBusNameLostCallback = Nothing busNameLostCallbackWrapper :: Maybe (Ptr (FunPtr (BusNameLostCallbackC))) -> BusNameLostCallback -> Ptr DBusConnection -> CString -> Ptr () -> IO () busNameLostCallbackWrapper funptrptr _cb connection name _ = do connection' <- (newObject DBusConnection) connection name' <- cstringToText name _cb connection' name' maybeReleaseFunPtr funptrptr -- Flags BusNameOwnerFlags data BusNameOwnerFlags = BusNameOwnerFlagsNone | BusNameOwnerFlagsAllowReplacement | BusNameOwnerFlagsReplace | AnotherBusNameOwnerFlags Int deriving (Show, Eq) instance Enum BusNameOwnerFlags where fromEnum BusNameOwnerFlagsNone = 0 fromEnum BusNameOwnerFlagsAllowReplacement = 1 fromEnum BusNameOwnerFlagsReplace = 2 fromEnum (AnotherBusNameOwnerFlags k) = k toEnum 0 = BusNameOwnerFlagsNone toEnum 1 = BusNameOwnerFlagsAllowReplacement toEnum 2 = BusNameOwnerFlagsReplace toEnum k = AnotherBusNameOwnerFlags k foreign import ccall "g_bus_name_owner_flags_get_type" c_g_bus_name_owner_flags_get_type :: IO GType instance BoxedEnum BusNameOwnerFlags where boxedEnumType _ = c_g_bus_name_owner_flags_get_type instance IsGFlag BusNameOwnerFlags -- callback BusNameVanishedCallback busNameVanishedCallbackClosure :: BusNameVanishedCallback -> IO Closure busNameVanishedCallbackClosure cb = newCClosure =<< mkBusNameVanishedCallback wrapped where wrapped = busNameVanishedCallbackWrapper Nothing cb type BusNameVanishedCallbackC = Ptr DBusConnection -> CString -> Ptr () -> IO () foreign import ccall "wrapper" mkBusNameVanishedCallback :: BusNameVanishedCallbackC -> IO (FunPtr BusNameVanishedCallbackC) type BusNameVanishedCallback = DBusConnection -> T.Text -> IO () noBusNameVanishedCallback :: Maybe BusNameVanishedCallback noBusNameVanishedCallback = Nothing busNameVanishedCallbackWrapper :: Maybe (Ptr (FunPtr (BusNameVanishedCallbackC))) -> BusNameVanishedCallback -> Ptr DBusConnection -> CString -> Ptr () -> IO () busNameVanishedCallbackWrapper funptrptr _cb connection name _ = do connection' <- (newObject DBusConnection) connection name' <- cstringToText name _cb connection' name' maybeReleaseFunPtr funptrptr -- Flags BusNameWatcherFlags data BusNameWatcherFlags = BusNameWatcherFlagsNone | BusNameWatcherFlagsAutoStart | AnotherBusNameWatcherFlags Int deriving (Show, Eq) instance Enum BusNameWatcherFlags where fromEnum BusNameWatcherFlagsNone = 0 fromEnum BusNameWatcherFlagsAutoStart = 1 fromEnum (AnotherBusNameWatcherFlags k) = k toEnum 0 = BusNameWatcherFlagsNone toEnum 1 = BusNameWatcherFlagsAutoStart toEnum k = AnotherBusNameWatcherFlags k foreign import ccall "g_bus_name_watcher_flags_get_type" c_g_bus_name_watcher_flags_get_type :: IO GType instance BoxedEnum BusNameWatcherFlags where boxedEnumType _ = c_g_bus_name_watcher_flags_get_type instance IsGFlag BusNameWatcherFlags -- Enum BusType data BusType = BusTypeStarter | BusTypeNone | BusTypeSystem | BusTypeSession | AnotherBusType Int deriving (Show, Eq) instance Enum BusType where fromEnum BusTypeStarter = -1 fromEnum BusTypeNone = 0 fromEnum BusTypeSystem = 1 fromEnum BusTypeSession = 2 fromEnum (AnotherBusType k) = k toEnum -1 = BusTypeStarter toEnum 0 = BusTypeNone toEnum 1 = BusTypeSystem toEnum 2 = BusTypeSession toEnum k = AnotherBusType k foreign import ccall "g_bus_type_get_type" c_g_bus_type_get_type :: IO GType instance BoxedEnum BusType where boxedEnumType _ = c_g_bus_type_get_type -- object BytesIcon newtype BytesIcon = BytesIcon (ForeignPtr BytesIcon) noBytesIcon :: Maybe BytesIcon noBytesIcon = Nothing foreign import ccall "g_bytes_icon_get_type" c_g_bytes_icon_get_type :: IO GType type instance ParentTypes BytesIcon = '[GObject.Object, Icon, LoadableIcon] instance GObject BytesIcon where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_bytes_icon_get_type class GObject o => BytesIconK o instance (GObject o, IsDescendantOf BytesIcon o) => BytesIconK o toBytesIcon :: BytesIconK o => o -> IO BytesIcon toBytesIcon = unsafeCastTo BytesIcon -- method BytesIcon::new -- method type : Constructor -- Args : [Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "BytesIcon" -- throws : False -- Skip return : False foreign import ccall "g_bytes_icon_new" g_bytes_icon_new :: Ptr GLib.Bytes -> -- bytes : TInterface "GLib" "Bytes" IO (Ptr BytesIcon) bytesIconNew :: (MonadIO m) => GLib.Bytes -> -- bytes m BytesIcon bytesIconNew bytes = liftIO $ do let bytes' = unsafeManagedPtrGetPtr bytes result <- g_bytes_icon_new bytes' checkUnexpectedReturnNULL "g_bytes_icon_new" result result' <- (wrapObject BytesIcon) result touchManagedPtr bytes return result' -- method BytesIcon::get_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "BytesIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "BytesIcon", 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_icon_get_bytes" g_bytes_icon_get_bytes :: Ptr BytesIcon -> -- _obj : TInterface "Gio" "BytesIcon" IO (Ptr GLib.Bytes) bytesIconGetBytes :: (MonadIO m, BytesIconK a) => a -> -- _obj m GLib.Bytes bytesIconGetBytes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_bytes_icon_get_bytes _obj' checkUnexpectedReturnNULL "g_bytes_icon_get_bytes" result result' <- (newBoxed GLib.Bytes) result touchManagedPtr _obj return result' -- object Cancellable newtype Cancellable = Cancellable (ForeignPtr Cancellable) noCancellable :: Maybe Cancellable noCancellable = Nothing foreign import ccall "g_cancellable_get_type" c_g_cancellable_get_type :: IO GType type instance ParentTypes Cancellable = '[GObject.Object] instance GObject Cancellable where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_cancellable_get_type class GObject o => CancellableK o instance (GObject o, IsDescendantOf Cancellable o) => CancellableK o toCancellable :: CancellableK o => o -> IO Cancellable toCancellable = unsafeCastTo Cancellable -- method Cancellable::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "Cancellable" -- throws : False -- Skip return : False foreign import ccall "g_cancellable_new" g_cancellable_new :: IO (Ptr Cancellable) cancellableNew :: (MonadIO m) => m Cancellable cancellableNew = liftIO $ do result <- g_cancellable_new checkUnexpectedReturnNULL "g_cancellable_new" result result' <- (wrapObject Cancellable) result return result' -- method Cancellable::cancel -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cancellable_cancel" g_cancellable_cancel :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" IO () cancellableCancel :: (MonadIO m, CancellableK a) => a -> -- _obj m () cancellableCancel _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_cancellable_cancel _obj' touchManagedPtr _obj return () -- method Cancellable::connect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "GObject" "Callback", 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 = "data_destroy_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "GObject" "Callback", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_cancellable_connect" g_cancellable_connect :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" FunPtr GObject.CallbackC -> -- callback : TInterface "GObject" "Callback" Ptr () -> -- data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- data_destroy_func : TInterface "GLib" "DestroyNotify" IO Word64 cancellableConnect :: (MonadIO m, CancellableK a) => a -> -- _obj GObject.Callback -> -- callback m Word64 cancellableConnect _obj callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj callback' <- GObject.mkCallback (GObject.callbackWrapper Nothing callback) let data_ = castFunPtrToPtr callback' let data_destroy_func = safeFreeFunPtrPtr result <- g_cancellable_connect _obj' callback' data_ data_destroy_func touchManagedPtr _obj return result -- method Cancellable::disconnect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", 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_cancellable_disconnect" g_cancellable_disconnect :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" Word64 -> -- handler_id : TBasicType TUInt64 IO () cancellableDisconnect :: (MonadIO m, CancellableK a) => a -> -- _obj Word64 -> -- handler_id m () cancellableDisconnect _obj handler_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_cancellable_disconnect _obj' handler_id touchManagedPtr _obj return () -- method Cancellable::get_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_cancellable_get_fd" g_cancellable_get_fd :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" IO Int32 cancellableGetFd :: (MonadIO m, CancellableK a) => a -> -- _obj m Int32 cancellableGetFd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_cancellable_get_fd _obj' touchManagedPtr _obj return result -- method Cancellable::is_cancelled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_cancellable_is_cancelled" g_cancellable_is_cancelled :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" IO CInt cancellableIsCancelled :: (MonadIO m, CancellableK a) => a -> -- _obj m Bool cancellableIsCancelled _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_cancellable_is_cancelled _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Cancellable::make_pollfd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pollfd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pollfd", argType = TInterface "GLib" "PollFD", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_cancellable_make_pollfd" g_cancellable_make_pollfd :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" Ptr GLib.PollFD -> -- pollfd : TInterface "GLib" "PollFD" IO CInt cancellableMakePollfd :: (MonadIO m, CancellableK a) => a -> -- _obj GLib.PollFD -> -- pollfd m Bool cancellableMakePollfd _obj pollfd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let pollfd' = unsafeManagedPtrGetPtr pollfd result <- g_cancellable_make_pollfd _obj' pollfd' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr pollfd return result' -- method Cancellable::pop_current -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cancellable_pop_current" g_cancellable_pop_current :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" IO () cancellablePopCurrent :: (MonadIO m, CancellableK a) => a -> -- _obj m () cancellablePopCurrent _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_cancellable_pop_current _obj' touchManagedPtr _obj return () -- method Cancellable::push_current -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cancellable_push_current" g_cancellable_push_current :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" IO () cancellablePushCurrent :: (MonadIO m, CancellableK a) => a -> -- _obj m () cancellablePushCurrent _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_cancellable_push_current _obj' touchManagedPtr _obj return () -- method Cancellable::release_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cancellable_release_fd" g_cancellable_release_fd :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" IO () cancellableReleaseFd :: (MonadIO m, CancellableK a) => a -> -- _obj m () cancellableReleaseFd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_cancellable_release_fd _obj' touchManagedPtr _obj return () -- method Cancellable::reset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cancellable_reset" g_cancellable_reset :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" IO () cancellableReset :: (MonadIO m, CancellableK a) => a -> -- _obj m () cancellableReset _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_cancellable_reset _obj' touchManagedPtr _obj return () -- method Cancellable::set_error_if_cancelled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_cancellable_set_error_if_cancelled" g_cancellable_set_error_if_cancelled :: Ptr Cancellable -> -- _obj : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt cancellableSetErrorIfCancelled :: (MonadIO m, CancellableK a) => a -> -- _obj m () cancellableSetErrorIfCancelled _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_cancellable_set_error_if_cancelled _obj' touchManagedPtr _obj return () ) (do return () ) -- method Cancellable::get_current -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "Cancellable" -- throws : False -- Skip return : False foreign import ccall "g_cancellable_get_current" g_cancellable_get_current :: IO (Ptr Cancellable) cancellableGetCurrent :: (MonadIO m) => m Cancellable cancellableGetCurrent = liftIO $ do result <- g_cancellable_get_current checkUnexpectedReturnNULL "g_cancellable_get_current" result result' <- (newObject Cancellable) result return result' -- signal Cancellable::cancelled type CancellableCancelledCallback = IO () noCancellableCancelledCallback :: Maybe CancellableCancelledCallback noCancellableCancelledCallback = Nothing type CancellableCancelledCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkCancellableCancelledCallback :: CancellableCancelledCallbackC -> IO (FunPtr CancellableCancelledCallbackC) cancellableCancelledClosure :: CancellableCancelledCallback -> IO Closure cancellableCancelledClosure cb = newCClosure =<< mkCancellableCancelledCallback wrapped where wrapped = cancellableCancelledCallbackWrapper cb cancellableCancelledCallbackWrapper :: CancellableCancelledCallback -> Ptr () -> Ptr () -> IO () cancellableCancelledCallbackWrapper _cb _ _ = do _cb onCancellableCancelled :: (GObject a, MonadIO m) => a -> CancellableCancelledCallback -> m SignalHandlerId onCancellableCancelled obj cb = liftIO $ connectCancellableCancelled obj cb SignalConnectBefore afterCancellableCancelled :: (GObject a, MonadIO m) => a -> CancellableCancelledCallback -> m SignalHandlerId afterCancellableCancelled obj cb = connectCancellableCancelled obj cb SignalConnectAfter connectCancellableCancelled :: (GObject a, MonadIO m) => a -> CancellableCancelledCallback -> SignalConnectMode -> m SignalHandlerId connectCancellableCancelled obj cb after = liftIO $ do cb' <- mkCancellableCancelledCallback (cancellableCancelledCallbackWrapper cb) connectSignalFunPtr obj "cancelled" cb' after -- callback CancellableSourceFunc cancellableSourceFuncClosure :: CancellableSourceFunc -> IO Closure cancellableSourceFuncClosure cb = newCClosure =<< mkCancellableSourceFunc wrapped where wrapped = cancellableSourceFuncWrapper Nothing cb type CancellableSourceFuncC = Ptr Cancellable -> Ptr () -> IO CInt foreign import ccall "wrapper" mkCancellableSourceFunc :: CancellableSourceFuncC -> IO (FunPtr CancellableSourceFuncC) type CancellableSourceFunc = Maybe Cancellable -> IO Bool noCancellableSourceFunc :: Maybe CancellableSourceFunc noCancellableSourceFunc = Nothing cancellableSourceFuncWrapper :: Maybe (Ptr (FunPtr (CancellableSourceFuncC))) -> CancellableSourceFunc -> Ptr Cancellable -> Ptr () -> IO CInt cancellableSourceFuncWrapper funptrptr _cb cancellable _ = do maybeCancellable <- if cancellable == nullPtr then return Nothing else do cancellable' <- (newObject Cancellable) cancellable return $ Just cancellable' result <- _cb maybeCancellable maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- object CharsetConverter newtype CharsetConverter = CharsetConverter (ForeignPtr CharsetConverter) noCharsetConverter :: Maybe CharsetConverter noCharsetConverter = Nothing foreign import ccall "g_charset_converter_get_type" c_g_charset_converter_get_type :: IO GType type instance ParentTypes CharsetConverter = '[GObject.Object, Converter, Initable] instance GObject CharsetConverter where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_charset_converter_get_type class GObject o => CharsetConverterK o instance (GObject o, IsDescendantOf CharsetConverter o) => CharsetConverterK o toCharsetConverter :: CharsetConverterK o => o -> IO CharsetConverter toCharsetConverter = unsafeCastTo CharsetConverter -- method CharsetConverter::new -- method type : Constructor -- Args : [Arg {argName = "to_charset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "from_charset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "to_charset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "from_charset", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "CharsetConverter" -- throws : True -- Skip return : False foreign import ccall "g_charset_converter_new" g_charset_converter_new :: CString -> -- to_charset : TBasicType TUTF8 CString -> -- from_charset : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr CharsetConverter) charsetConverterNew :: (MonadIO m) => T.Text -> -- to_charset T.Text -> -- from_charset m CharsetConverter charsetConverterNew to_charset from_charset = liftIO $ do to_charset' <- textToCString to_charset from_charset' <- textToCString from_charset onException (do result <- propagateGError $ g_charset_converter_new to_charset' from_charset' checkUnexpectedReturnNULL "g_charset_converter_new" result result' <- (wrapObject CharsetConverter) result freeMem to_charset' freeMem from_charset' return result' ) (do freeMem to_charset' freeMem from_charset' ) -- method CharsetConverter::get_num_fallbacks -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "CharsetConverter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "CharsetConverter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_charset_converter_get_num_fallbacks" g_charset_converter_get_num_fallbacks :: Ptr CharsetConverter -> -- _obj : TInterface "Gio" "CharsetConverter" IO Word32 charsetConverterGetNumFallbacks :: (MonadIO m, CharsetConverterK a) => a -> -- _obj m Word32 charsetConverterGetNumFallbacks _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_charset_converter_get_num_fallbacks _obj' touchManagedPtr _obj return result -- method CharsetConverter::get_use_fallback -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "CharsetConverter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "CharsetConverter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_charset_converter_get_use_fallback" g_charset_converter_get_use_fallback :: Ptr CharsetConverter -> -- _obj : TInterface "Gio" "CharsetConverter" IO CInt charsetConverterGetUseFallback :: (MonadIO m, CharsetConverterK a) => a -> -- _obj m Bool charsetConverterGetUseFallback _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_charset_converter_get_use_fallback _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method CharsetConverter::set_use_fallback -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "CharsetConverter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_fallback", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "CharsetConverter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_fallback", 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_charset_converter_set_use_fallback" g_charset_converter_set_use_fallback :: Ptr CharsetConverter -> -- _obj : TInterface "Gio" "CharsetConverter" CInt -> -- use_fallback : TBasicType TBoolean IO () charsetConverterSetUseFallback :: (MonadIO m, CharsetConverterK a) => a -> -- _obj Bool -> -- use_fallback m () charsetConverterSetUseFallback _obj use_fallback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let use_fallback' = (fromIntegral . fromEnum) use_fallback g_charset_converter_set_use_fallback _obj' use_fallback' touchManagedPtr _obj return () -- interface Converter newtype Converter = Converter (ForeignPtr Converter) noConverter :: Maybe Converter noConverter = Nothing foreign import ccall "g_converter_get_type" c_g_converter_get_type :: IO GType type instance ParentTypes Converter = '[GObject.Object] instance GObject Converter where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_converter_get_type class GObject o => ConverterK o instance (GObject o, IsDescendantOf Converter o) => ConverterK o toConverter :: ConverterK o => o -> IO Converter toConverter = unsafeCastTo Converter -- method Converter::convert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Converter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inbuf", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inbuf_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbuf", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbuf_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ConverterFlags", 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 = "inbuf_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Converter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inbuf", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbuf", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "outbuf_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ConverterFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ConverterResult" -- throws : True -- Skip return : False foreign import ccall "g_converter_convert" g_converter_convert :: Ptr Converter -> -- _obj : TInterface "Gio" "Converter" Ptr Word8 -> -- inbuf : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- inbuf_size : TBasicType TUInt64 Ptr () -> -- outbuf : TBasicType TVoid Word64 -> -- outbuf_size : TBasicType TUInt64 CUInt -> -- flags : TInterface "Gio" "ConverterFlags" Ptr Word64 -> -- bytes_read : TBasicType TUInt64 Ptr Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CUInt converterConvert :: (MonadIO m, ConverterK a) => a -> -- _obj ByteString -> -- inbuf Ptr () -> -- outbuf Word64 -> -- outbuf_size [ConverterFlags] -> -- flags m (ConverterResult,Word64,Word64) converterConvert _obj inbuf outbuf outbuf_size flags = liftIO $ do let inbuf_size = fromIntegral $ B.length inbuf let _obj' = unsafeManagedPtrCastPtr _obj inbuf' <- packByteString inbuf let flags' = gflagsToWord flags bytes_read <- allocMem :: IO (Ptr Word64) bytes_written <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_converter_convert _obj' inbuf' inbuf_size outbuf outbuf_size flags' bytes_read bytes_written let result' = (toEnum . fromIntegral) result bytes_read' <- peek bytes_read bytes_written' <- peek bytes_written touchManagedPtr _obj freeMem inbuf' freeMem bytes_read freeMem bytes_written return (result', bytes_read', bytes_written') ) (do freeMem inbuf' freeMem bytes_read freeMem bytes_written ) -- method Converter::reset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Converter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Converter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_converter_reset" g_converter_reset :: Ptr Converter -> -- _obj : TInterface "Gio" "Converter" IO () converterReset :: (MonadIO m, ConverterK a) => a -> -- _obj m () converterReset _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_converter_reset _obj' touchManagedPtr _obj return () -- Flags ConverterFlags data ConverterFlags = ConverterFlagsNone | ConverterFlagsInputAtEnd | ConverterFlagsFlush | AnotherConverterFlags Int deriving (Show, Eq) instance Enum ConverterFlags where fromEnum ConverterFlagsNone = 0 fromEnum ConverterFlagsInputAtEnd = 1 fromEnum ConverterFlagsFlush = 2 fromEnum (AnotherConverterFlags k) = k toEnum 0 = ConverterFlagsNone toEnum 1 = ConverterFlagsInputAtEnd toEnum 2 = ConverterFlagsFlush toEnum k = AnotherConverterFlags k foreign import ccall "g_converter_flags_get_type" c_g_converter_flags_get_type :: IO GType instance BoxedEnum ConverterFlags where boxedEnumType _ = c_g_converter_flags_get_type instance IsGFlag ConverterFlags -- object ConverterInputStream newtype ConverterInputStream = ConverterInputStream (ForeignPtr ConverterInputStream) noConverterInputStream :: Maybe ConverterInputStream noConverterInputStream = Nothing foreign import ccall "g_converter_input_stream_get_type" c_g_converter_input_stream_get_type :: IO GType type instance ParentTypes ConverterInputStream = '[FilterInputStream, InputStream, GObject.Object, PollableInputStream] instance GObject ConverterInputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_converter_input_stream_get_type class GObject o => ConverterInputStreamK o instance (GObject o, IsDescendantOf ConverterInputStream o) => ConverterInputStreamK o toConverterInputStream :: ConverterInputStreamK o => o -> IO ConverterInputStream toConverterInputStream = unsafeCastTo ConverterInputStream -- method ConverterInputStream::new -- method type : Constructor -- Args : [Arg {argName = "base_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "converter", argType = TInterface "Gio" "Converter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "converter", argType = TInterface "Gio" "Converter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ConverterInputStream" -- throws : False -- Skip return : False foreign import ccall "g_converter_input_stream_new" g_converter_input_stream_new :: Ptr InputStream -> -- base_stream : TInterface "Gio" "InputStream" Ptr Converter -> -- converter : TInterface "Gio" "Converter" IO (Ptr ConverterInputStream) converterInputStreamNew :: (MonadIO m, InputStreamK a, ConverterK b) => a -> -- base_stream b -> -- converter m ConverterInputStream converterInputStreamNew base_stream converter = liftIO $ do let base_stream' = unsafeManagedPtrCastPtr base_stream let converter' = unsafeManagedPtrCastPtr converter result <- g_converter_input_stream_new base_stream' converter' checkUnexpectedReturnNULL "g_converter_input_stream_new" result result' <- (wrapObject ConverterInputStream) result touchManagedPtr base_stream touchManagedPtr converter return result' -- method ConverterInputStream::get_converter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ConverterInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ConverterInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Converter" -- throws : False -- Skip return : False foreign import ccall "g_converter_input_stream_get_converter" g_converter_input_stream_get_converter :: Ptr ConverterInputStream -> -- _obj : TInterface "Gio" "ConverterInputStream" IO (Ptr Converter) converterInputStreamGetConverter :: (MonadIO m, ConverterInputStreamK a) => a -> -- _obj m Converter converterInputStreamGetConverter _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_converter_input_stream_get_converter _obj' checkUnexpectedReturnNULL "g_converter_input_stream_get_converter" result result' <- (newObject Converter) result touchManagedPtr _obj return result' -- object ConverterOutputStream newtype ConverterOutputStream = ConverterOutputStream (ForeignPtr ConverterOutputStream) noConverterOutputStream :: Maybe ConverterOutputStream noConverterOutputStream = Nothing foreign import ccall "g_converter_output_stream_get_type" c_g_converter_output_stream_get_type :: IO GType type instance ParentTypes ConverterOutputStream = '[FilterOutputStream, OutputStream, GObject.Object, PollableOutputStream] instance GObject ConverterOutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_converter_output_stream_get_type class GObject o => ConverterOutputStreamK o instance (GObject o, IsDescendantOf ConverterOutputStream o) => ConverterOutputStreamK o toConverterOutputStream :: ConverterOutputStreamK o => o -> IO ConverterOutputStream toConverterOutputStream = unsafeCastTo ConverterOutputStream -- method ConverterOutputStream::new -- method type : Constructor -- Args : [Arg {argName = "base_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "converter", argType = TInterface "Gio" "Converter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "converter", argType = TInterface "Gio" "Converter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ConverterOutputStream" -- throws : False -- Skip return : False foreign import ccall "g_converter_output_stream_new" g_converter_output_stream_new :: Ptr OutputStream -> -- base_stream : TInterface "Gio" "OutputStream" Ptr Converter -> -- converter : TInterface "Gio" "Converter" IO (Ptr ConverterOutputStream) converterOutputStreamNew :: (MonadIO m, OutputStreamK a, ConverterK b) => a -> -- base_stream b -> -- converter m ConverterOutputStream converterOutputStreamNew base_stream converter = liftIO $ do let base_stream' = unsafeManagedPtrCastPtr base_stream let converter' = unsafeManagedPtrCastPtr converter result <- g_converter_output_stream_new base_stream' converter' checkUnexpectedReturnNULL "g_converter_output_stream_new" result result' <- (wrapObject ConverterOutputStream) result touchManagedPtr base_stream touchManagedPtr converter return result' -- method ConverterOutputStream::get_converter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ConverterOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ConverterOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Converter" -- throws : False -- Skip return : False foreign import ccall "g_converter_output_stream_get_converter" g_converter_output_stream_get_converter :: Ptr ConverterOutputStream -> -- _obj : TInterface "Gio" "ConverterOutputStream" IO (Ptr Converter) converterOutputStreamGetConverter :: (MonadIO m, ConverterOutputStreamK a) => a -> -- _obj m Converter converterOutputStreamGetConverter _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_converter_output_stream_get_converter _obj' checkUnexpectedReturnNULL "g_converter_output_stream_get_converter" result result' <- (newObject Converter) result touchManagedPtr _obj return result' -- Enum ConverterResult data ConverterResult = ConverterResultError | ConverterResultConverted | ConverterResultFinished | ConverterResultFlushed | AnotherConverterResult Int deriving (Show, Eq) instance Enum ConverterResult where fromEnum ConverterResultError = 0 fromEnum ConverterResultConverted = 1 fromEnum ConverterResultFinished = 2 fromEnum ConverterResultFlushed = 3 fromEnum (AnotherConverterResult k) = k toEnum 0 = ConverterResultError toEnum 1 = ConverterResultConverted toEnum 2 = ConverterResultFinished toEnum 3 = ConverterResultFlushed toEnum k = AnotherConverterResult k foreign import ccall "g_converter_result_get_type" c_g_converter_result_get_type :: IO GType instance BoxedEnum ConverterResult where boxedEnumType _ = c_g_converter_result_get_type -- object Credentials newtype Credentials = Credentials (ForeignPtr Credentials) noCredentials :: Maybe Credentials noCredentials = Nothing foreign import ccall "g_credentials_get_type" c_g_credentials_get_type :: IO GType type instance ParentTypes Credentials = '[GObject.Object] instance GObject Credentials where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_credentials_get_type class GObject o => CredentialsK o instance (GObject o, IsDescendantOf Credentials o) => CredentialsK o toCredentials :: CredentialsK o => o -> IO Credentials toCredentials = unsafeCastTo Credentials -- method Credentials::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "Credentials" -- throws : False -- Skip return : False foreign import ccall "g_credentials_new" g_credentials_new :: IO (Ptr Credentials) credentialsNew :: (MonadIO m) => m Credentials credentialsNew = liftIO $ do result <- g_credentials_new checkUnexpectedReturnNULL "g_credentials_new" result result' <- (wrapObject Credentials) result return result' -- method Credentials::get_unix_pid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_credentials_get_unix_pid" g_credentials_get_unix_pid :: Ptr Credentials -> -- _obj : TInterface "Gio" "Credentials" Ptr (Ptr GError) -> -- error IO Int32 credentialsGetUnixPid :: (MonadIO m, CredentialsK a) => a -> -- _obj m Int32 credentialsGetUnixPid _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_credentials_get_unix_pid _obj' touchManagedPtr _obj return result ) (do return () ) -- method Credentials::get_unix_user -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : True -- Skip return : False foreign import ccall "g_credentials_get_unix_user" g_credentials_get_unix_user :: Ptr Credentials -> -- _obj : TInterface "Gio" "Credentials" Ptr (Ptr GError) -> -- error IO Word32 credentialsGetUnixUser :: (MonadIO m, CredentialsK a) => a -> -- _obj m Word32 credentialsGetUnixUser _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_credentials_get_unix_user _obj' touchManagedPtr _obj return result ) (do return () ) -- method Credentials::is_same_user -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other_credentials", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other_credentials", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_credentials_is_same_user" g_credentials_is_same_user :: Ptr Credentials -> -- _obj : TInterface "Gio" "Credentials" Ptr Credentials -> -- other_credentials : TInterface "Gio" "Credentials" Ptr (Ptr GError) -> -- error IO CInt credentialsIsSameUser :: (MonadIO m, CredentialsK a, CredentialsK b) => a -> -- _obj b -> -- other_credentials m () credentialsIsSameUser _obj other_credentials = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let other_credentials' = unsafeManagedPtrCastPtr other_credentials onException (do _ <- propagateGError $ g_credentials_is_same_user _obj' other_credentials' touchManagedPtr _obj touchManagedPtr other_credentials return () ) (do return () ) -- method Credentials::set_native -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "native_type", argType = TInterface "Gio" "CredentialsType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "native", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "native_type", argType = TInterface "Gio" "CredentialsType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "native", 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_credentials_set_native" g_credentials_set_native :: Ptr Credentials -> -- _obj : TInterface "Gio" "Credentials" CUInt -> -- native_type : TInterface "Gio" "CredentialsType" Ptr () -> -- native : TBasicType TVoid IO () credentialsSetNative :: (MonadIO m, CredentialsK a) => a -> -- _obj CredentialsType -> -- native_type Ptr () -> -- native m () credentialsSetNative _obj native_type native = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let native_type' = (fromIntegral . fromEnum) native_type g_credentials_set_native _obj' native_type' native touchManagedPtr _obj return () -- method Credentials::set_unix_user -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uid", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uid", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_credentials_set_unix_user" g_credentials_set_unix_user :: Ptr Credentials -> -- _obj : TInterface "Gio" "Credentials" Word32 -> -- uid : TBasicType TUInt32 Ptr (Ptr GError) -> -- error IO CInt credentialsSetUnixUser :: (MonadIO m, CredentialsK a) => a -> -- _obj Word32 -> -- uid m () credentialsSetUnixUser _obj uid = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_credentials_set_unix_user _obj' uid touchManagedPtr _obj return () ) (do return () ) -- method Credentials::to_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_credentials_to_string" g_credentials_to_string :: Ptr Credentials -> -- _obj : TInterface "Gio" "Credentials" IO CString credentialsToString :: (MonadIO m, CredentialsK a) => a -> -- _obj m T.Text credentialsToString _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_credentials_to_string _obj' checkUnexpectedReturnNULL "g_credentials_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- Enum CredentialsType data CredentialsType = CredentialsTypeInvalid | CredentialsTypeLinuxUcred | CredentialsTypeFreebsdCmsgcred | CredentialsTypeOpenbsdSockpeercred | CredentialsTypeSolarisUcred | CredentialsTypeNetbsdUnpcbid | AnotherCredentialsType Int deriving (Show, Eq) instance Enum CredentialsType where fromEnum CredentialsTypeInvalid = 0 fromEnum CredentialsTypeLinuxUcred = 1 fromEnum CredentialsTypeFreebsdCmsgcred = 2 fromEnum CredentialsTypeOpenbsdSockpeercred = 3 fromEnum CredentialsTypeSolarisUcred = 4 fromEnum CredentialsTypeNetbsdUnpcbid = 5 fromEnum (AnotherCredentialsType k) = k toEnum 0 = CredentialsTypeInvalid toEnum 1 = CredentialsTypeLinuxUcred toEnum 2 = CredentialsTypeFreebsdCmsgcred toEnum 3 = CredentialsTypeOpenbsdSockpeercred toEnum 4 = CredentialsTypeSolarisUcred toEnum 5 = CredentialsTypeNetbsdUnpcbid toEnum k = AnotherCredentialsType k foreign import ccall "g_credentials_type_get_type" c_g_credentials_type_get_type :: IO GType instance BoxedEnum CredentialsType where boxedEnumType _ = c_g_credentials_type_get_type -- object DBusActionGroup newtype DBusActionGroup = DBusActionGroup (ForeignPtr DBusActionGroup) noDBusActionGroup :: Maybe DBusActionGroup noDBusActionGroup = Nothing foreign import ccall "g_dbus_action_group_get_type" c_g_dbus_action_group_get_type :: IO GType type instance ParentTypes DBusActionGroup = '[GObject.Object, ActionGroup, RemoteActionGroup] instance GObject DBusActionGroup where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_action_group_get_type class GObject o => DBusActionGroupK o instance (GObject o, IsDescendantOf DBusActionGroup o) => DBusActionGroupK o toDBusActionGroup :: DBusActionGroupK o => o -> IO DBusActionGroup toDBusActionGroup = unsafeCastTo DBusActionGroup -- method DBusActionGroup::get -- method type : MemberFunction -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusActionGroup" -- throws : False -- Skip return : False foreign import ccall "g_dbus_action_group_get" g_dbus_action_group_get :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CString -> -- bus_name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 IO (Ptr DBusActionGroup) dBusActionGroupGet :: (MonadIO m, DBusConnectionK a) => a -> -- connection T.Text -> -- bus_name T.Text -> -- object_path m DBusActionGroup dBusActionGroupGet connection bus_name object_path = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection bus_name' <- textToCString bus_name object_path' <- textToCString object_path result <- g_dbus_action_group_get connection' bus_name' object_path' checkUnexpectedReturnNULL "g_dbus_action_group_get" result result' <- (wrapObject DBusActionGroup) result touchManagedPtr connection freeMem bus_name' freeMem object_path' return result' -- struct DBusAnnotationInfo newtype DBusAnnotationInfo = DBusAnnotationInfo (ForeignPtr DBusAnnotationInfo) noDBusAnnotationInfo :: Maybe DBusAnnotationInfo noDBusAnnotationInfo = Nothing foreign import ccall "g_dbus_annotation_info_get_type" c_g_dbus_annotation_info_get_type :: IO GType instance BoxedObject DBusAnnotationInfo where boxedType _ = c_g_dbus_annotation_info_get_type dBusAnnotationInfoReadRefCount :: DBusAnnotationInfo -> IO Int32 dBusAnnotationInfoReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val dBusAnnotationInfoReadKey :: DBusAnnotationInfo -> IO T.Text dBusAnnotationInfoReadKey s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' dBusAnnotationInfoReadValue :: DBusAnnotationInfo -> IO T.Text dBusAnnotationInfoReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' dBusAnnotationInfoReadAnnotations :: DBusAnnotationInfo -> IO [DBusAnnotationInfo] dBusAnnotationInfoReadAnnotations s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr (Ptr DBusAnnotationInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusAnnotationInfo) val' return val'' -- method DBusAnnotationInfo::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusAnnotationInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusAnnotationInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusAnnotationInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_annotation_info_ref" g_dbus_annotation_info_ref :: Ptr DBusAnnotationInfo -> -- _obj : TInterface "Gio" "DBusAnnotationInfo" IO (Ptr DBusAnnotationInfo) dBusAnnotationInfoRef :: (MonadIO m) => DBusAnnotationInfo -> -- _obj m DBusAnnotationInfo dBusAnnotationInfoRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_dbus_annotation_info_ref _obj' checkUnexpectedReturnNULL "g_dbus_annotation_info_ref" result result' <- (wrapBoxed DBusAnnotationInfo) result touchManagedPtr _obj return result' -- method DBusAnnotationInfo::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusAnnotationInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusAnnotationInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_annotation_info_unref" g_dbus_annotation_info_unref :: Ptr DBusAnnotationInfo -> -- _obj : TInterface "Gio" "DBusAnnotationInfo" IO () dBusAnnotationInfoUnref :: (MonadIO m) => DBusAnnotationInfo -> -- _obj m () dBusAnnotationInfoUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_annotation_info_unref _obj' touchManagedPtr _obj return () -- struct DBusArgInfo newtype DBusArgInfo = DBusArgInfo (ForeignPtr DBusArgInfo) noDBusArgInfo :: Maybe DBusArgInfo noDBusArgInfo = Nothing foreign import ccall "g_dbus_arg_info_get_type" c_g_dbus_arg_info_get_type :: IO GType instance BoxedObject DBusArgInfo where boxedType _ = c_g_dbus_arg_info_get_type dBusArgInfoReadRefCount :: DBusArgInfo -> IO Int32 dBusArgInfoReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val dBusArgInfoReadName :: DBusArgInfo -> IO T.Text dBusArgInfoReadName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' dBusArgInfoReadSignature :: DBusArgInfo -> IO T.Text dBusArgInfoReadSignature s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' dBusArgInfoReadAnnotations :: DBusArgInfo -> IO [DBusAnnotationInfo] dBusArgInfoReadAnnotations s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr (Ptr DBusAnnotationInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusAnnotationInfo) val' return val'' -- method DBusArgInfo::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusArgInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusArgInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusArgInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_arg_info_ref" g_dbus_arg_info_ref :: Ptr DBusArgInfo -> -- _obj : TInterface "Gio" "DBusArgInfo" IO (Ptr DBusArgInfo) dBusArgInfoRef :: (MonadIO m) => DBusArgInfo -> -- _obj m DBusArgInfo dBusArgInfoRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_dbus_arg_info_ref _obj' checkUnexpectedReturnNULL "g_dbus_arg_info_ref" result result' <- (wrapBoxed DBusArgInfo) result touchManagedPtr _obj return result' -- method DBusArgInfo::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusArgInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusArgInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_arg_info_unref" g_dbus_arg_info_unref :: Ptr DBusArgInfo -> -- _obj : TInterface "Gio" "DBusArgInfo" IO () dBusArgInfoUnref :: (MonadIO m) => DBusArgInfo -> -- _obj m () dBusArgInfoUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_arg_info_unref _obj' touchManagedPtr _obj return () -- object DBusAuthObserver newtype DBusAuthObserver = DBusAuthObserver (ForeignPtr DBusAuthObserver) noDBusAuthObserver :: Maybe DBusAuthObserver noDBusAuthObserver = Nothing foreign import ccall "g_dbus_auth_observer_get_type" c_g_dbus_auth_observer_get_type :: IO GType type instance ParentTypes DBusAuthObserver = '[GObject.Object] instance GObject DBusAuthObserver where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_auth_observer_get_type class GObject o => DBusAuthObserverK o instance (GObject o, IsDescendantOf DBusAuthObserver o) => DBusAuthObserverK o toDBusAuthObserver :: DBusAuthObserverK o => o -> IO DBusAuthObserver toDBusAuthObserver = unsafeCastTo DBusAuthObserver -- method DBusAuthObserver::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "DBusAuthObserver" -- throws : False -- Skip return : False foreign import ccall "g_dbus_auth_observer_new" g_dbus_auth_observer_new :: IO (Ptr DBusAuthObserver) dBusAuthObserverNew :: (MonadIO m) => m DBusAuthObserver dBusAuthObserverNew = liftIO $ do result <- g_dbus_auth_observer_new checkUnexpectedReturnNULL "g_dbus_auth_observer_new" result result' <- (wrapObject DBusAuthObserver) result return result' -- method DBusAuthObserver::allow_mechanism -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mechanism", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mechanism", 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_dbus_auth_observer_allow_mechanism" g_dbus_auth_observer_allow_mechanism :: Ptr DBusAuthObserver -> -- _obj : TInterface "Gio" "DBusAuthObserver" CString -> -- mechanism : TBasicType TUTF8 IO CInt dBusAuthObserverAllowMechanism :: (MonadIO m, DBusAuthObserverK a) => a -> -- _obj T.Text -> -- mechanism m Bool dBusAuthObserverAllowMechanism _obj mechanism = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj mechanism' <- textToCString mechanism result <- g_dbus_auth_observer_allow_mechanism _obj' mechanism' let result' = (/= 0) result touchManagedPtr _obj freeMem mechanism' return result' -- method DBusAuthObserver::authorize_authenticated_peer -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "credentials", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "credentials", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_auth_observer_authorize_authenticated_peer" g_dbus_auth_observer_authorize_authenticated_peer :: Ptr DBusAuthObserver -> -- _obj : TInterface "Gio" "DBusAuthObserver" Ptr IOStream -> -- stream : TInterface "Gio" "IOStream" Ptr Credentials -> -- credentials : TInterface "Gio" "Credentials" IO CInt dBusAuthObserverAuthorizeAuthenticatedPeer :: (MonadIO m, DBusAuthObserverK a, IOStreamK b, CredentialsK c) => a -> -- _obj b -> -- stream Maybe (c) -> -- credentials m Bool dBusAuthObserverAuthorizeAuthenticatedPeer _obj stream credentials = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let stream' = unsafeManagedPtrCastPtr stream maybeCredentials <- case credentials of Nothing -> return nullPtr Just jCredentials -> do let jCredentials' = unsafeManagedPtrCastPtr jCredentials return jCredentials' result <- g_dbus_auth_observer_authorize_authenticated_peer _obj' stream' maybeCredentials let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr stream whenJust credentials touchManagedPtr return result' -- signal DBusAuthObserver::allow-mechanism type DBusAuthObserverAllowMechanismCallback = T.Text -> IO Bool noDBusAuthObserverAllowMechanismCallback :: Maybe DBusAuthObserverAllowMechanismCallback noDBusAuthObserverAllowMechanismCallback = Nothing type DBusAuthObserverAllowMechanismCallbackC = Ptr () -> -- object CString -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkDBusAuthObserverAllowMechanismCallback :: DBusAuthObserverAllowMechanismCallbackC -> IO (FunPtr DBusAuthObserverAllowMechanismCallbackC) dBusAuthObserverAllowMechanismClosure :: DBusAuthObserverAllowMechanismCallback -> IO Closure dBusAuthObserverAllowMechanismClosure cb = newCClosure =<< mkDBusAuthObserverAllowMechanismCallback wrapped where wrapped = dBusAuthObserverAllowMechanismCallbackWrapper cb dBusAuthObserverAllowMechanismCallbackWrapper :: DBusAuthObserverAllowMechanismCallback -> Ptr () -> CString -> Ptr () -> IO CInt dBusAuthObserverAllowMechanismCallbackWrapper _cb _ mechanism _ = do mechanism' <- cstringToText mechanism result <- _cb mechanism' let result' = (fromIntegral . fromEnum) result return result' onDBusAuthObserverAllowMechanism :: (GObject a, MonadIO m) => a -> DBusAuthObserverAllowMechanismCallback -> m SignalHandlerId onDBusAuthObserverAllowMechanism obj cb = liftIO $ connectDBusAuthObserverAllowMechanism obj cb SignalConnectBefore afterDBusAuthObserverAllowMechanism :: (GObject a, MonadIO m) => a -> DBusAuthObserverAllowMechanismCallback -> m SignalHandlerId afterDBusAuthObserverAllowMechanism obj cb = connectDBusAuthObserverAllowMechanism obj cb SignalConnectAfter connectDBusAuthObserverAllowMechanism :: (GObject a, MonadIO m) => a -> DBusAuthObserverAllowMechanismCallback -> SignalConnectMode -> m SignalHandlerId connectDBusAuthObserverAllowMechanism obj cb after = liftIO $ do cb' <- mkDBusAuthObserverAllowMechanismCallback (dBusAuthObserverAllowMechanismCallbackWrapper cb) connectSignalFunPtr obj "allow-mechanism" cb' after -- signal DBusAuthObserver::authorize-authenticated-peer type DBusAuthObserverAuthorizeAuthenticatedPeerCallback = IOStream -> Maybe Credentials -> IO Bool noDBusAuthObserverAuthorizeAuthenticatedPeerCallback :: Maybe DBusAuthObserverAuthorizeAuthenticatedPeerCallback noDBusAuthObserverAuthorizeAuthenticatedPeerCallback = Nothing type DBusAuthObserverAuthorizeAuthenticatedPeerCallbackC = Ptr () -> -- object Ptr IOStream -> Ptr Credentials -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkDBusAuthObserverAuthorizeAuthenticatedPeerCallback :: DBusAuthObserverAuthorizeAuthenticatedPeerCallbackC -> IO (FunPtr DBusAuthObserverAuthorizeAuthenticatedPeerCallbackC) dBusAuthObserverAuthorizeAuthenticatedPeerClosure :: DBusAuthObserverAuthorizeAuthenticatedPeerCallback -> IO Closure dBusAuthObserverAuthorizeAuthenticatedPeerClosure cb = newCClosure =<< mkDBusAuthObserverAuthorizeAuthenticatedPeerCallback wrapped where wrapped = dBusAuthObserverAuthorizeAuthenticatedPeerCallbackWrapper cb dBusAuthObserverAuthorizeAuthenticatedPeerCallbackWrapper :: DBusAuthObserverAuthorizeAuthenticatedPeerCallback -> Ptr () -> Ptr IOStream -> Ptr Credentials -> Ptr () -> IO CInt dBusAuthObserverAuthorizeAuthenticatedPeerCallbackWrapper _cb _ stream credentials _ = do stream' <- (newObject IOStream) stream maybeCredentials <- if credentials == nullPtr then return Nothing else do credentials' <- (newObject Credentials) credentials return $ Just credentials' result <- _cb stream' maybeCredentials let result' = (fromIntegral . fromEnum) result return result' onDBusAuthObserverAuthorizeAuthenticatedPeer :: (GObject a, MonadIO m) => a -> DBusAuthObserverAuthorizeAuthenticatedPeerCallback -> m SignalHandlerId onDBusAuthObserverAuthorizeAuthenticatedPeer obj cb = liftIO $ connectDBusAuthObserverAuthorizeAuthenticatedPeer obj cb SignalConnectBefore afterDBusAuthObserverAuthorizeAuthenticatedPeer :: (GObject a, MonadIO m) => a -> DBusAuthObserverAuthorizeAuthenticatedPeerCallback -> m SignalHandlerId afterDBusAuthObserverAuthorizeAuthenticatedPeer obj cb = connectDBusAuthObserverAuthorizeAuthenticatedPeer obj cb SignalConnectAfter connectDBusAuthObserverAuthorizeAuthenticatedPeer :: (GObject a, MonadIO m) => a -> DBusAuthObserverAuthorizeAuthenticatedPeerCallback -> SignalConnectMode -> m SignalHandlerId connectDBusAuthObserverAuthorizeAuthenticatedPeer obj cb after = liftIO $ do cb' <- mkDBusAuthObserverAuthorizeAuthenticatedPeerCallback (dBusAuthObserverAuthorizeAuthenticatedPeerCallbackWrapper cb) connectSignalFunPtr obj "authorize-authenticated-peer" cb' after -- Flags DBusCallFlags data DBusCallFlags = DBusCallFlagsNone | DBusCallFlagsNoAutoStart | AnotherDBusCallFlags Int deriving (Show, Eq) instance Enum DBusCallFlags where fromEnum DBusCallFlagsNone = 0 fromEnum DBusCallFlagsNoAutoStart = 1 fromEnum (AnotherDBusCallFlags k) = k toEnum 0 = DBusCallFlagsNone toEnum 1 = DBusCallFlagsNoAutoStart toEnum k = AnotherDBusCallFlags k foreign import ccall "g_dbus_call_flags_get_type" c_g_dbus_call_flags_get_type :: IO GType instance BoxedEnum DBusCallFlags where boxedEnumType _ = c_g_dbus_call_flags_get_type instance IsGFlag DBusCallFlags -- Flags DBusCapabilityFlags data DBusCapabilityFlags = DBusCapabilityFlagsNone | DBusCapabilityFlagsUnixFdPassing | AnotherDBusCapabilityFlags Int deriving (Show, Eq) instance Enum DBusCapabilityFlags where fromEnum DBusCapabilityFlagsNone = 0 fromEnum DBusCapabilityFlagsUnixFdPassing = 1 fromEnum (AnotherDBusCapabilityFlags k) = k toEnum 0 = DBusCapabilityFlagsNone toEnum 1 = DBusCapabilityFlagsUnixFdPassing toEnum k = AnotherDBusCapabilityFlags k foreign import ccall "g_dbus_capability_flags_get_type" c_g_dbus_capability_flags_get_type :: IO GType instance BoxedEnum DBusCapabilityFlags where boxedEnumType _ = c_g_dbus_capability_flags_get_type instance IsGFlag DBusCapabilityFlags -- object DBusConnection newtype DBusConnection = DBusConnection (ForeignPtr DBusConnection) noDBusConnection :: Maybe DBusConnection noDBusConnection = Nothing foreign import ccall "g_dbus_connection_get_type" c_g_dbus_connection_get_type :: IO GType type instance ParentTypes DBusConnection = '[GObject.Object, AsyncInitable, Initable] instance GObject DBusConnection where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_connection_get_type class GObject o => DBusConnectionK o instance (GObject o, IsDescendantOf DBusConnection o) => DBusConnectionK o toDBusConnection :: DBusConnectionK o => o -> IO DBusConnection toDBusConnection = unsafeCastTo DBusConnection -- method DBusConnection::new_finish -- method type : Constructor -- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_new_finish" g_dbus_connection_new_finish :: Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr DBusConnection) dBusConnectionNewFinish :: (MonadIO m, AsyncResultK a) => a -> -- res m DBusConnection dBusConnectionNewFinish res = liftIO $ do let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_connection_new_finish res' checkUnexpectedReturnNULL "g_dbus_connection_new_finish" result result' <- (wrapObject DBusConnection) result touchManagedPtr res return result' ) (do return () ) -- method DBusConnection::new_for_address_finish -- method type : Constructor -- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_new_for_address_finish" g_dbus_connection_new_for_address_finish :: Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr DBusConnection) dBusConnectionNewForAddressFinish :: (MonadIO m, AsyncResultK a) => a -> -- res m DBusConnection dBusConnectionNewForAddressFinish res = liftIO $ do let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_connection_new_for_address_finish res' checkUnexpectedReturnNULL "g_dbus_connection_new_for_address_finish" result result' <- (wrapObject DBusConnection) result touchManagedPtr res return result' ) (do return () ) -- method DBusConnection::new_for_address_sync -- method type : Constructor -- Args : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusConnectionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusConnectionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_new_for_address_sync" g_dbus_connection_new_for_address_sync :: CString -> -- address : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "DBusConnectionFlags" Ptr DBusAuthObserver -> -- observer : TInterface "Gio" "DBusAuthObserver" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusConnection) dBusConnectionNewForAddressSync :: (MonadIO m, DBusAuthObserverK a, CancellableK b) => T.Text -> -- address [DBusConnectionFlags] -> -- flags Maybe (a) -> -- observer Maybe (b) -> -- cancellable m DBusConnection dBusConnectionNewForAddressSync address flags observer cancellable = liftIO $ do address' <- textToCString address let flags' = gflagsToWord flags maybeObserver <- case observer of Nothing -> return nullPtr Just jObserver -> do let jObserver' = unsafeManagedPtrCastPtr jObserver return jObserver' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_connection_new_for_address_sync address' flags' maybeObserver maybeCancellable checkUnexpectedReturnNULL "g_dbus_connection_new_for_address_sync" result result' <- (wrapObject DBusConnection) result whenJust observer touchManagedPtr whenJust cancellable touchManagedPtr freeMem address' return result' ) (do freeMem address' ) -- method DBusConnection::new_sync -- method type : Constructor -- Args : [Arg {argName = "stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusConnectionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusConnectionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_new_sync" g_dbus_connection_new_sync :: Ptr IOStream -> -- stream : TInterface "Gio" "IOStream" CString -> -- guid : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "DBusConnectionFlags" Ptr DBusAuthObserver -> -- observer : TInterface "Gio" "DBusAuthObserver" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusConnection) dBusConnectionNewSync :: (MonadIO m, IOStreamK a, DBusAuthObserverK b, CancellableK c) => a -> -- stream Maybe (T.Text) -> -- guid [DBusConnectionFlags] -> -- flags Maybe (b) -> -- observer Maybe (c) -> -- cancellable m DBusConnection dBusConnectionNewSync stream guid flags observer cancellable = liftIO $ do let stream' = unsafeManagedPtrCastPtr stream maybeGuid <- case guid of Nothing -> return nullPtr Just jGuid -> do jGuid' <- textToCString jGuid return jGuid' let flags' = gflagsToWord flags maybeObserver <- case observer of Nothing -> return nullPtr Just jObserver -> do let jObserver' = unsafeManagedPtrCastPtr jObserver return jObserver' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_connection_new_sync stream' maybeGuid flags' maybeObserver maybeCancellable checkUnexpectedReturnNULL "g_dbus_connection_new_sync" result result' <- (wrapObject DBusConnection) result touchManagedPtr stream whenJust observer touchManagedPtr whenJust cancellable touchManagedPtr freeMem maybeGuid return result' ) (do freeMem maybeGuid ) -- method DBusConnection::add_filter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter_function", argType = TInterface "Gio" "DBusMessageFilterFunction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, 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_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 "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter_function", argType = TInterface "Gio" "DBusMessageFilterFunction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_add_filter" g_dbus_connection_add_filter :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" FunPtr DBusMessageFilterFunctionC -> -- filter_function : TInterface "Gio" "DBusMessageFilterFunction" Ptr () -> -- user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- user_data_free_func : TInterface "GLib" "DestroyNotify" IO Word32 dBusConnectionAddFilter :: (MonadIO m, DBusConnectionK a) => a -> -- _obj DBusMessageFilterFunction -> -- filter_function m Word32 dBusConnectionAddFilter _obj filter_function = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj filter_function' <- mkDBusMessageFilterFunction (dBusMessageFilterFunctionWrapper Nothing filter_function) let user_data = castFunPtrToPtr filter_function' let user_data_free_func = safeFreeFunPtrPtr result <- g_dbus_connection_add_filter _obj' filter_function' user_data user_data_free_func touchManagedPtr _obj return result -- method DBusConnection::call -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reply_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 11, 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 "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reply_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 11, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_call" g_dbus_connection_call :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- bus_name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 CString -> -- method_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant Ptr GLib.VariantType -> -- reply_type : TInterface "GLib" "VariantType" CUInt -> -- flags : TInterface "Gio" "DBusCallFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusConnectionCall :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- _obj Maybe (T.Text) -> -- bus_name T.Text -> -- object_path T.Text -> -- interface_name T.Text -> -- method_name Maybe (GVariant) -> -- parameters Maybe (GLib.VariantType) -> -- reply_type [DBusCallFlags] -> -- flags Int32 -> -- timeout_msec Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusConnectionCall _obj bus_name object_path interface_name method_name parameters reply_type flags timeout_msec cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeBus_name <- case bus_name of Nothing -> return nullPtr Just jBus_name -> do jBus_name' <- textToCString jBus_name return jBus_name' object_path' <- textToCString object_path interface_name' <- textToCString interface_name method_name' <- textToCString method_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' maybeReply_type <- case reply_type of Nothing -> return nullPtr Just jReply_type -> do let jReply_type' = unsafeManagedPtrGetPtr jReply_type return jReply_type' let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_connection_call _obj' maybeBus_name object_path' interface_name' method_name' maybeParameters maybeReply_type flags' timeout_msec maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust reply_type touchManagedPtr whenJust cancellable touchManagedPtr freeMem maybeBus_name freeMem object_path' freeMem interface_name' freeMem method_name' return () -- method DBusConnection::call_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_call_finish" g_dbus_connection_call_finish :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr GVariant) dBusConnectionCallFinish :: (MonadIO m, DBusConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- res m GVariant dBusConnectionCallFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_connection_call_finish _obj' res' checkUnexpectedReturnNULL "g_dbus_connection_call_finish" result result' <- wrapGVariantPtr result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method DBusConnection::call_sync -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reply_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reply_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_call_sync" g_dbus_connection_call_sync :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- bus_name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 CString -> -- method_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant Ptr GLib.VariantType -> -- reply_type : TInterface "GLib" "VariantType" CUInt -> -- flags : TInterface "Gio" "DBusCallFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr GVariant) dBusConnectionCallSync :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- _obj Maybe (T.Text) -> -- bus_name T.Text -> -- object_path T.Text -> -- interface_name T.Text -> -- method_name Maybe (GVariant) -> -- parameters Maybe (GLib.VariantType) -> -- reply_type [DBusCallFlags] -> -- flags Int32 -> -- timeout_msec Maybe (b) -> -- cancellable m GVariant dBusConnectionCallSync _obj bus_name object_path interface_name method_name parameters reply_type flags timeout_msec cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeBus_name <- case bus_name of Nothing -> return nullPtr Just jBus_name -> do jBus_name' <- textToCString jBus_name return jBus_name' object_path' <- textToCString object_path interface_name' <- textToCString interface_name method_name' <- textToCString method_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' maybeReply_type <- case reply_type of Nothing -> return nullPtr Just jReply_type -> do let jReply_type' = unsafeManagedPtrGetPtr jReply_type return jReply_type' let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_connection_call_sync _obj' maybeBus_name object_path' interface_name' method_name' maybeParameters maybeReply_type flags' timeout_msec maybeCancellable checkUnexpectedReturnNULL "g_dbus_connection_call_sync" result result' <- wrapGVariantPtr result touchManagedPtr _obj whenJust reply_type touchManagedPtr whenJust cancellable touchManagedPtr freeMem maybeBus_name freeMem object_path' freeMem interface_name' freeMem method_name' return result' ) (do freeMem maybeBus_name freeMem object_path' freeMem interface_name' freeMem method_name' ) -- method DBusConnection::call_with_unix_fd_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reply_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 12, 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 "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reply_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 12, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_call_with_unix_fd_list" g_dbus_connection_call_with_unix_fd_list :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- bus_name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 CString -> -- method_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant Ptr GLib.VariantType -> -- reply_type : TInterface "GLib" "VariantType" CUInt -> -- flags : TInterface "Gio" "DBusCallFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr UnixFDList -> -- fd_list : TInterface "Gio" "UnixFDList" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusConnectionCallWithUnixFdList :: (MonadIO m, DBusConnectionK a, UnixFDListK b, CancellableK c) => a -> -- _obj Maybe (T.Text) -> -- bus_name T.Text -> -- object_path T.Text -> -- interface_name T.Text -> -- method_name Maybe (GVariant) -> -- parameters Maybe (GLib.VariantType) -> -- reply_type [DBusCallFlags] -> -- flags Int32 -> -- timeout_msec Maybe (b) -> -- fd_list Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusConnectionCallWithUnixFdList _obj bus_name object_path interface_name method_name parameters reply_type flags timeout_msec fd_list cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeBus_name <- case bus_name of Nothing -> return nullPtr Just jBus_name -> do jBus_name' <- textToCString jBus_name return jBus_name' object_path' <- textToCString object_path interface_name' <- textToCString interface_name method_name' <- textToCString method_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' maybeReply_type <- case reply_type of Nothing -> return nullPtr Just jReply_type -> do let jReply_type' = unsafeManagedPtrGetPtr jReply_type return jReply_type' let flags' = gflagsToWord flags maybeFd_list <- case fd_list of Nothing -> return nullPtr Just jFd_list -> do let jFd_list' = unsafeManagedPtrCastPtr jFd_list return jFd_list' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_connection_call_with_unix_fd_list _obj' maybeBus_name object_path' interface_name' method_name' maybeParameters maybeReply_type flags' timeout_msec maybeFd_list maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust reply_type touchManagedPtr whenJust fd_list touchManagedPtr whenJust cancellable touchManagedPtr freeMem maybeBus_name freeMem object_path' freeMem interface_name' freeMem method_name' return () -- method DBusConnection::call_with_unix_fd_list_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_call_with_unix_fd_list_finish" g_dbus_connection_call_with_unix_fd_list_finish :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr (Ptr UnixFDList) -> -- out_fd_list : TInterface "Gio" "UnixFDList" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr GVariant) dBusConnectionCallWithUnixFdListFinish :: (MonadIO m, DBusConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- res m (GVariant,UnixFDList) dBusConnectionCallWithUnixFdListFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj out_fd_list <- allocMem :: IO (Ptr (Ptr UnixFDList)) let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_connection_call_with_unix_fd_list_finish _obj' out_fd_list res' checkUnexpectedReturnNULL "g_dbus_connection_call_with_unix_fd_list_finish" result result' <- wrapGVariantPtr result out_fd_list' <- peek out_fd_list out_fd_list'' <- (wrapObject UnixFDList) out_fd_list' touchManagedPtr _obj touchManagedPtr res freeMem out_fd_list return (result', out_fd_list'') ) (do freeMem out_fd_list ) -- method DBusConnection::call_with_unix_fd_list_sync -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reply_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reply_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_call_with_unix_fd_list_sync" g_dbus_connection_call_with_unix_fd_list_sync :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- bus_name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 CString -> -- method_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant Ptr GLib.VariantType -> -- reply_type : TInterface "GLib" "VariantType" CUInt -> -- flags : TInterface "Gio" "DBusCallFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr UnixFDList -> -- fd_list : TInterface "Gio" "UnixFDList" Ptr (Ptr UnixFDList) -> -- out_fd_list : TInterface "Gio" "UnixFDList" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr GVariant) dBusConnectionCallWithUnixFdListSync :: (MonadIO m, DBusConnectionK a, UnixFDListK b, CancellableK c) => a -> -- _obj Maybe (T.Text) -> -- bus_name T.Text -> -- object_path T.Text -> -- interface_name T.Text -> -- method_name Maybe (GVariant) -> -- parameters Maybe (GLib.VariantType) -> -- reply_type [DBusCallFlags] -> -- flags Int32 -> -- timeout_msec Maybe (b) -> -- fd_list Maybe (c) -> -- cancellable m (GVariant,UnixFDList) dBusConnectionCallWithUnixFdListSync _obj bus_name object_path interface_name method_name parameters reply_type flags timeout_msec fd_list cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeBus_name <- case bus_name of Nothing -> return nullPtr Just jBus_name -> do jBus_name' <- textToCString jBus_name return jBus_name' object_path' <- textToCString object_path interface_name' <- textToCString interface_name method_name' <- textToCString method_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' maybeReply_type <- case reply_type of Nothing -> return nullPtr Just jReply_type -> do let jReply_type' = unsafeManagedPtrGetPtr jReply_type return jReply_type' let flags' = gflagsToWord flags maybeFd_list <- case fd_list of Nothing -> return nullPtr Just jFd_list -> do let jFd_list' = unsafeManagedPtrCastPtr jFd_list return jFd_list' out_fd_list <- allocMem :: IO (Ptr (Ptr UnixFDList)) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_connection_call_with_unix_fd_list_sync _obj' maybeBus_name object_path' interface_name' method_name' maybeParameters maybeReply_type flags' timeout_msec maybeFd_list out_fd_list maybeCancellable checkUnexpectedReturnNULL "g_dbus_connection_call_with_unix_fd_list_sync" result result' <- wrapGVariantPtr result out_fd_list' <- peek out_fd_list out_fd_list'' <- (wrapObject UnixFDList) out_fd_list' touchManagedPtr _obj whenJust reply_type touchManagedPtr whenJust fd_list touchManagedPtr whenJust cancellable touchManagedPtr freeMem maybeBus_name freeMem object_path' freeMem interface_name' freeMem method_name' freeMem out_fd_list return (result', out_fd_list'') ) (do freeMem maybeBus_name freeMem object_path' freeMem interface_name' freeMem method_name' freeMem out_fd_list ) -- method DBusConnection::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_close" g_dbus_connection_close :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusConnectionClose :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusConnectionClose _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_connection_close _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method DBusConnection::close_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_close_finish" g_dbus_connection_close_finish :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt dBusConnectionCloseFinish :: (MonadIO m, DBusConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- res m () dBusConnectionCloseFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do _ <- propagateGError $ g_dbus_connection_close_finish _obj' res' touchManagedPtr _obj touchManagedPtr res return () ) (do return () ) -- method DBusConnection::close_sync -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_close_sync" g_dbus_connection_close_sync :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dBusConnectionCloseSync :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () dBusConnectionCloseSync _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_dbus_connection_close_sync _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DBusConnection::emit_signal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destination_bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destination_bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_emit_signal" g_dbus_connection_emit_signal :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- destination_bus_name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 CString -> -- signal_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant Ptr (Ptr GError) -> -- error IO CInt dBusConnectionEmitSignal :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Maybe (T.Text) -> -- destination_bus_name T.Text -> -- object_path T.Text -> -- interface_name T.Text -> -- signal_name Maybe (GVariant) -> -- parameters m () dBusConnectionEmitSignal _obj destination_bus_name object_path interface_name signal_name parameters = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeDestination_bus_name <- case destination_bus_name of Nothing -> return nullPtr Just jDestination_bus_name -> do jDestination_bus_name' <- textToCString jDestination_bus_name return jDestination_bus_name' object_path' <- textToCString object_path interface_name' <- textToCString interface_name signal_name' <- textToCString signal_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' onException (do _ <- propagateGError $ g_dbus_connection_emit_signal _obj' maybeDestination_bus_name object_path' interface_name' signal_name' maybeParameters touchManagedPtr _obj freeMem maybeDestination_bus_name freeMem object_path' freeMem interface_name' freeMem signal_name' return () ) (do freeMem maybeDestination_bus_name freeMem object_path' freeMem interface_name' freeMem signal_name' ) -- method DBusConnection::export_action_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_group", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_group", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_export_action_group" g_dbus_connection_export_action_group :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- object_path : TBasicType TUTF8 Ptr ActionGroup -> -- action_group : TInterface "Gio" "ActionGroup" Ptr (Ptr GError) -> -- error IO Word32 dBusConnectionExportActionGroup :: (MonadIO m, DBusConnectionK a, ActionGroupK b) => a -> -- _obj T.Text -> -- object_path b -> -- action_group m Word32 dBusConnectionExportActionGroup _obj object_path action_group = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj object_path' <- textToCString object_path let action_group' = unsafeManagedPtrCastPtr action_group onException (do result <- propagateGError $ g_dbus_connection_export_action_group _obj' object_path' action_group' touchManagedPtr _obj touchManagedPtr action_group freeMem object_path' return result ) (do freeMem object_path' ) -- method DBusConnection::export_menu_model -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_export_menu_model" g_dbus_connection_export_menu_model :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- object_path : TBasicType TUTF8 Ptr MenuModel -> -- menu : TInterface "Gio" "MenuModel" Ptr (Ptr GError) -> -- error IO Word32 dBusConnectionExportMenuModel :: (MonadIO m, DBusConnectionK a, MenuModelK b) => a -> -- _obj T.Text -> -- object_path b -> -- menu m Word32 dBusConnectionExportMenuModel _obj object_path menu = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj object_path' <- textToCString object_path let menu' = unsafeManagedPtrCastPtr menu onException (do result <- propagateGError $ g_dbus_connection_export_menu_model _obj' object_path' menu' touchManagedPtr _obj touchManagedPtr menu freeMem object_path' return result ) (do freeMem object_path' ) -- method DBusConnection::flush -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_flush" g_dbus_connection_flush :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusConnectionFlush :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusConnectionFlush _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_connection_flush _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method DBusConnection::flush_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_flush_finish" g_dbus_connection_flush_finish :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt dBusConnectionFlushFinish :: (MonadIO m, DBusConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- res m () dBusConnectionFlushFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do _ <- propagateGError $ g_dbus_connection_flush_finish _obj' res' touchManagedPtr _obj touchManagedPtr res return () ) (do return () ) -- method DBusConnection::flush_sync -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_flush_sync" g_dbus_connection_flush_sync :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dBusConnectionFlushSync :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () dBusConnectionFlushSync _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_dbus_connection_flush_sync _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DBusConnection::get_capabilities -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusCapabilityFlags" -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_get_capabilities" g_dbus_connection_get_capabilities :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO CUInt dBusConnectionGetCapabilities :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m [DBusCapabilityFlags] dBusConnectionGetCapabilities _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_get_capabilities _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method DBusConnection::get_exit_on_close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_get_exit_on_close" g_dbus_connection_get_exit_on_close :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO CInt dBusConnectionGetExitOnClose :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m Bool dBusConnectionGetExitOnClose _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_get_exit_on_close _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method DBusConnection::get_guid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_get_guid" g_dbus_connection_get_guid :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO CString dBusConnectionGetGuid :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m T.Text dBusConnectionGetGuid _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_get_guid _obj' checkUnexpectedReturnNULL "g_dbus_connection_get_guid" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusConnection::get_last_serial -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_get_last_serial" g_dbus_connection_get_last_serial :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO Word32 dBusConnectionGetLastSerial :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m Word32 dBusConnectionGetLastSerial _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_get_last_serial _obj' touchManagedPtr _obj return result -- method DBusConnection::get_peer_credentials -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Credentials" -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_get_peer_credentials" g_dbus_connection_get_peer_credentials :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO (Ptr Credentials) dBusConnectionGetPeerCredentials :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m Credentials dBusConnectionGetPeerCredentials _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_get_peer_credentials _obj' checkUnexpectedReturnNULL "g_dbus_connection_get_peer_credentials" result result' <- (newObject Credentials) result touchManagedPtr _obj return result' -- method DBusConnection::get_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "IOStream" -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_get_stream" g_dbus_connection_get_stream :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO (Ptr IOStream) dBusConnectionGetStream :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m IOStream dBusConnectionGetStream _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_get_stream _obj' checkUnexpectedReturnNULL "g_dbus_connection_get_stream" result result' <- (newObject IOStream) result touchManagedPtr _obj return result' -- method DBusConnection::get_unique_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_get_unique_name" g_dbus_connection_get_unique_name :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO CString dBusConnectionGetUniqueName :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m T.Text dBusConnectionGetUniqueName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_get_unique_name _obj' checkUnexpectedReturnNULL "g_dbus_connection_get_unique_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusConnection::is_closed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_is_closed" g_dbus_connection_is_closed :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO CInt dBusConnectionIsClosed :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m Bool dBusConnectionIsClosed _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_is_closed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method DBusConnection::register_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "vtable", argType = TInterface "Gio" "DBusInterfaceVTable", direction = DirectionIn, mayBeNull = True, 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 = "user_data_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 "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "vtable", argType = TInterface "Gio" "DBusInterfaceVTable", direction = DirectionIn, mayBeNull = True, 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 = "user_data_free_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_register_object" g_dbus_connection_register_object :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- object_path : TBasicType TUTF8 Ptr DBusInterfaceInfo -> -- interface_info : TInterface "Gio" "DBusInterfaceInfo" Ptr DBusInterfaceVTable -> -- vtable : TInterface "Gio" "DBusInterfaceVTable" Ptr () -> -- user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- user_data_free_func : TInterface "GLib" "DestroyNotify" Ptr (Ptr GError) -> -- error IO Word32 dBusConnectionRegisterObject :: (MonadIO m, DBusConnectionK a) => a -> -- _obj T.Text -> -- object_path DBusInterfaceInfo -> -- interface_info Maybe (DBusInterfaceVTable) -> -- vtable Maybe (Ptr ()) -> -- user_data GLib.DestroyNotify -> -- user_data_free_func m Word32 dBusConnectionRegisterObject _obj object_path interface_info vtable user_data user_data_free_func = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj object_path' <- textToCString object_path let interface_info' = unsafeManagedPtrGetPtr interface_info maybeVtable <- case vtable of Nothing -> return nullPtr Just jVtable -> do let jVtable' = unsafeManagedPtrGetPtr jVtable return jVtable' maybeUser_data <- case user_data of Nothing -> return nullPtr Just jUser_data -> do return jUser_data ptruser_data_free_func <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) user_data_free_func' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptruser_data_free_func) user_data_free_func) poke ptruser_data_free_func user_data_free_func' onException (do result <- propagateGError $ g_dbus_connection_register_object _obj' object_path' interface_info' maybeVtable maybeUser_data user_data_free_func' touchManagedPtr _obj touchManagedPtr interface_info whenJust vtable touchManagedPtr freeMem object_path' return result ) (do freeMem object_path' ) -- method DBusConnection::register_subtree -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "vtable", argType = TInterface "Gio" "DBusSubtreeVTable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSubtreeFlags", 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_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 "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "vtable", argType = TInterface "Gio" "DBusSubtreeVTable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSubtreeFlags", 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_free_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_register_subtree" g_dbus_connection_register_subtree :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- object_path : TBasicType TUTF8 Ptr DBusSubtreeVTable -> -- vtable : TInterface "Gio" "DBusSubtreeVTable" CUInt -> -- flags : TInterface "Gio" "DBusSubtreeFlags" Ptr () -> -- user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- user_data_free_func : TInterface "GLib" "DestroyNotify" Ptr (Ptr GError) -> -- error IO Word32 dBusConnectionRegisterSubtree :: (MonadIO m, DBusConnectionK a) => a -> -- _obj T.Text -> -- object_path DBusSubtreeVTable -> -- vtable [DBusSubtreeFlags] -> -- flags Ptr () -> -- user_data GLib.DestroyNotify -> -- user_data_free_func m Word32 dBusConnectionRegisterSubtree _obj object_path vtable flags user_data user_data_free_func = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj object_path' <- textToCString object_path let vtable' = unsafeManagedPtrGetPtr vtable let flags' = gflagsToWord flags ptruser_data_free_func <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) user_data_free_func' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptruser_data_free_func) user_data_free_func) poke ptruser_data_free_func user_data_free_func' onException (do result <- propagateGError $ g_dbus_connection_register_subtree _obj' object_path' vtable' flags' user_data user_data_free_func' touchManagedPtr _obj touchManagedPtr vtable freeMem object_path' return result ) (do freeMem object_path' ) -- method DBusConnection::remove_filter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter_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_dbus_connection_remove_filter" g_dbus_connection_remove_filter :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Word32 -> -- filter_id : TBasicType TUInt32 IO () dBusConnectionRemoveFilter :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Word32 -> -- filter_id m () dBusConnectionRemoveFilter _obj filter_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_connection_remove_filter _obj' filter_id touchManagedPtr _obj return () -- method DBusConnection::send_message -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSendMessageFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_serial", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSendMessageFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_send_message" g_dbus_connection_send_message :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr DBusMessage -> -- message : TInterface "Gio" "DBusMessage" CUInt -> -- flags : TInterface "Gio" "DBusSendMessageFlags" Ptr Word32 -> -- out_serial : TBasicType TUInt32 Ptr (Ptr GError) -> -- error IO CInt dBusConnectionSendMessage :: (MonadIO m, DBusConnectionK a, DBusMessageK b) => a -> -- _obj b -> -- message [DBusSendMessageFlags] -> -- flags m (Word32) dBusConnectionSendMessage _obj message flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let message' = unsafeManagedPtrCastPtr message let flags' = gflagsToWord flags out_serial <- allocMem :: IO (Ptr Word32) onException (do _ <- propagateGError $ g_dbus_connection_send_message _obj' message' flags' out_serial out_serial' <- peek out_serial touchManagedPtr _obj touchManagedPtr message freeMem out_serial return out_serial' ) (do freeMem out_serial ) -- method DBusConnection::send_message_with_reply -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSendMessageFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_serial", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, 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 "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSendMessageFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_send_message_with_reply" g_dbus_connection_send_message_with_reply :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr DBusMessage -> -- message : TInterface "Gio" "DBusMessage" CUInt -> -- flags : TInterface "Gio" "DBusSendMessageFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr Word32 -> -- out_serial : TBasicType TUInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusConnectionSendMessageWithReply :: (MonadIO m, DBusConnectionK a, DBusMessageK b, CancellableK c) => a -> -- _obj b -> -- message [DBusSendMessageFlags] -> -- flags Int32 -> -- timeout_msec Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m (Word32) dBusConnectionSendMessageWithReply _obj message flags timeout_msec cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let message' = unsafeManagedPtrCastPtr message let flags' = gflagsToWord flags out_serial <- allocMem :: IO (Ptr Word32) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_connection_send_message_with_reply _obj' message' flags' timeout_msec out_serial maybeCancellable maybeCallback user_data out_serial' <- peek out_serial touchManagedPtr _obj touchManagedPtr message whenJust cancellable touchManagedPtr freeMem out_serial return out_serial' -- method DBusConnection::send_message_with_reply_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_send_message_with_reply_finish" g_dbus_connection_send_message_with_reply_finish :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr DBusMessage) dBusConnectionSendMessageWithReplyFinish :: (MonadIO m, DBusConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- res m DBusMessage dBusConnectionSendMessageWithReplyFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_connection_send_message_with_reply_finish _obj' res' checkUnexpectedReturnNULL "g_dbus_connection_send_message_with_reply_finish" result result' <- (wrapObject DBusMessage) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method DBusConnection::send_message_with_reply_sync -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSendMessageFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_serial", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "message", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSendMessageFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : True -- Skip return : False foreign import ccall "g_dbus_connection_send_message_with_reply_sync" g_dbus_connection_send_message_with_reply_sync :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Ptr DBusMessage -> -- message : TInterface "Gio" "DBusMessage" CUInt -> -- flags : TInterface "Gio" "DBusSendMessageFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr Word32 -> -- out_serial : TBasicType TUInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusMessage) dBusConnectionSendMessageWithReplySync :: (MonadIO m, DBusConnectionK a, DBusMessageK b, CancellableK c) => a -> -- _obj b -> -- message [DBusSendMessageFlags] -> -- flags Int32 -> -- timeout_msec Maybe (c) -> -- cancellable m (DBusMessage,Word32) dBusConnectionSendMessageWithReplySync _obj message flags timeout_msec cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let message' = unsafeManagedPtrCastPtr message let flags' = gflagsToWord flags out_serial <- allocMem :: IO (Ptr Word32) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_connection_send_message_with_reply_sync _obj' message' flags' timeout_msec out_serial maybeCancellable checkUnexpectedReturnNULL "g_dbus_connection_send_message_with_reply_sync" result result' <- (wrapObject DBusMessage) result out_serial' <- peek out_serial touchManagedPtr _obj touchManagedPtr message whenJust cancellable touchManagedPtr freeMem out_serial return (result', out_serial') ) (do freeMem out_serial ) -- method DBusConnection::set_exit_on_close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exit_on_close", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exit_on_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_dbus_connection_set_exit_on_close" g_dbus_connection_set_exit_on_close :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CInt -> -- exit_on_close : TBasicType TBoolean IO () dBusConnectionSetExitOnClose :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Bool -> -- exit_on_close m () dBusConnectionSetExitOnClose _obj exit_on_close = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let exit_on_close' = (fromIntegral . fromEnum) exit_on_close g_dbus_connection_set_exit_on_close _obj' exit_on_close' touchManagedPtr _obj return () -- method DBusConnection::signal_subscribe -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sender", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "member", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg0", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSignalFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "DBusSignalCallback", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 8, argDestroy = 9, 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_free_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sender", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "member", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg0", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusSignalFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "DBusSignalCallback", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 8, argDestroy = 9, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_signal_subscribe" g_dbus_connection_signal_subscribe :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" CString -> -- sender : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 CString -> -- member : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- arg0 : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "DBusSignalFlags" FunPtr DBusSignalCallbackC -> -- callback : TInterface "Gio" "DBusSignalCallback" Ptr () -> -- user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- user_data_free_func : TInterface "GLib" "DestroyNotify" IO Word32 dBusConnectionSignalSubscribe :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Maybe (T.Text) -> -- sender Maybe (T.Text) -> -- interface_name Maybe (T.Text) -> -- member Maybe (T.Text) -> -- object_path Maybe (T.Text) -> -- arg0 [DBusSignalFlags] -> -- flags DBusSignalCallback -> -- callback m Word32 dBusConnectionSignalSubscribe _obj sender interface_name member object_path arg0 flags callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeSender <- case sender of Nothing -> return nullPtr Just jSender -> do jSender' <- textToCString jSender return jSender' maybeInterface_name <- case interface_name of Nothing -> return nullPtr Just jInterface_name -> do jInterface_name' <- textToCString jInterface_name return jInterface_name' maybeMember <- case member of Nothing -> return nullPtr Just jMember -> do jMember' <- textToCString jMember return jMember' maybeObject_path <- case object_path of Nothing -> return nullPtr Just jObject_path -> do jObject_path' <- textToCString jObject_path return jObject_path' maybeArg0 <- case arg0 of Nothing -> return nullPtr Just jArg0 -> do jArg0' <- textToCString jArg0 return jArg0' let flags' = gflagsToWord flags callback' <- mkDBusSignalCallback (dBusSignalCallbackWrapper Nothing callback) let user_data = castFunPtrToPtr callback' let user_data_free_func = safeFreeFunPtrPtr result <- g_dbus_connection_signal_subscribe _obj' maybeSender maybeInterface_name maybeMember maybeObject_path maybeArg0 flags' callback' user_data user_data_free_func touchManagedPtr _obj freeMem maybeSender freeMem maybeInterface_name freeMem maybeMember freeMem maybeObject_path freeMem maybeArg0 return result -- method DBusConnection::signal_unsubscribe -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "subscription_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "subscription_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_dbus_connection_signal_unsubscribe" g_dbus_connection_signal_unsubscribe :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Word32 -> -- subscription_id : TBasicType TUInt32 IO () dBusConnectionSignalUnsubscribe :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Word32 -> -- subscription_id m () dBusConnectionSignalUnsubscribe _obj subscription_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_connection_signal_unsubscribe _obj' subscription_id touchManagedPtr _obj return () -- method DBusConnection::start_message_processing -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_start_message_processing" g_dbus_connection_start_message_processing :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" IO () dBusConnectionStartMessageProcessing :: (MonadIO m, DBusConnectionK a) => a -> -- _obj m () dBusConnectionStartMessageProcessing _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_connection_start_message_processing _obj' touchManagedPtr _obj return () -- method DBusConnection::unexport_action_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "export_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "export_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_dbus_connection_unexport_action_group" g_dbus_connection_unexport_action_group :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Word32 -> -- export_id : TBasicType TUInt32 IO () dBusConnectionUnexportActionGroup :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Word32 -> -- export_id m () dBusConnectionUnexportActionGroup _obj export_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_connection_unexport_action_group _obj' export_id touchManagedPtr _obj return () -- method DBusConnection::unexport_menu_model -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "export_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "export_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_dbus_connection_unexport_menu_model" g_dbus_connection_unexport_menu_model :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Word32 -> -- export_id : TBasicType TUInt32 IO () dBusConnectionUnexportMenuModel :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Word32 -> -- export_id m () dBusConnectionUnexportMenuModel _obj export_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_connection_unexport_menu_model _obj' export_id touchManagedPtr _obj return () -- method DBusConnection::unregister_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "registration_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "registration_id", 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_dbus_connection_unregister_object" g_dbus_connection_unregister_object :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Word32 -> -- registration_id : TBasicType TUInt32 IO CInt dBusConnectionUnregisterObject :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Word32 -> -- registration_id m Bool dBusConnectionUnregisterObject _obj registration_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_unregister_object _obj' registration_id let result' = (/= 0) result touchManagedPtr _obj return result' -- method DBusConnection::unregister_subtree -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "registration_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "registration_id", 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_dbus_connection_unregister_subtree" g_dbus_connection_unregister_subtree :: Ptr DBusConnection -> -- _obj : TInterface "Gio" "DBusConnection" Word32 -> -- registration_id : TBasicType TUInt32 IO CInt dBusConnectionUnregisterSubtree :: (MonadIO m, DBusConnectionK a) => a -> -- _obj Word32 -> -- registration_id m Bool dBusConnectionUnregisterSubtree _obj registration_id = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_connection_unregister_subtree _obj' registration_id let result' = (/= 0) result touchManagedPtr _obj return result' -- method DBusConnection::new -- method type : MemberFunction -- Args : [Arg {argName = "stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusConnectionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 = "stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusConnectionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_new" g_dbus_connection_new :: Ptr IOStream -> -- stream : TInterface "Gio" "IOStream" CString -> -- guid : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "DBusConnectionFlags" Ptr DBusAuthObserver -> -- observer : TInterface "Gio" "DBusAuthObserver" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusConnectionNew :: (MonadIO m, IOStreamK a, DBusAuthObserverK b, CancellableK c) => a -> -- stream Maybe (T.Text) -> -- guid [DBusConnectionFlags] -> -- flags Maybe (b) -> -- observer Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusConnectionNew stream guid flags observer cancellable callback = liftIO $ do let stream' = unsafeManagedPtrCastPtr stream maybeGuid <- case guid of Nothing -> return nullPtr Just jGuid -> do jGuid' <- textToCString jGuid return jGuid' let flags' = gflagsToWord flags maybeObserver <- case observer of Nothing -> return nullPtr Just jObserver -> do let jObserver' = unsafeManagedPtrCastPtr jObserver return jObserver' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_connection_new stream' maybeGuid flags' maybeObserver maybeCancellable maybeCallback user_data touchManagedPtr stream whenJust observer touchManagedPtr whenJust cancellable touchManagedPtr freeMem maybeGuid return () -- method DBusConnection::new_for_address -- method type : MemberFunction -- Args : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusConnectionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusConnectionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_connection_new_for_address" g_dbus_connection_new_for_address :: CString -> -- address : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "DBusConnectionFlags" Ptr DBusAuthObserver -> -- observer : TInterface "Gio" "DBusAuthObserver" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusConnectionNewForAddress :: (MonadIO m, DBusAuthObserverK a, CancellableK b) => T.Text -> -- address [DBusConnectionFlags] -> -- flags Maybe (a) -> -- observer Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusConnectionNewForAddress address flags observer cancellable callback = liftIO $ do address' <- textToCString address let flags' = gflagsToWord flags maybeObserver <- case observer of Nothing -> return nullPtr Just jObserver -> do let jObserver' = unsafeManagedPtrCastPtr jObserver return jObserver' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_connection_new_for_address address' flags' maybeObserver maybeCancellable maybeCallback user_data whenJust observer touchManagedPtr whenJust cancellable touchManagedPtr freeMem address' return () -- signal DBusConnection::closed type DBusConnectionClosedCallback = Bool -> Maybe GError -> IO () noDBusConnectionClosedCallback :: Maybe DBusConnectionClosedCallback noDBusConnectionClosedCallback = Nothing type DBusConnectionClosedCallbackC = Ptr () -> -- object CInt -> Ptr GError -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusConnectionClosedCallback :: DBusConnectionClosedCallbackC -> IO (FunPtr DBusConnectionClosedCallbackC) dBusConnectionClosedClosure :: DBusConnectionClosedCallback -> IO Closure dBusConnectionClosedClosure cb = newCClosure =<< mkDBusConnectionClosedCallback wrapped where wrapped = dBusConnectionClosedCallbackWrapper cb dBusConnectionClosedCallbackWrapper :: DBusConnectionClosedCallback -> Ptr () -> CInt -> Ptr GError -> Ptr () -> IO () dBusConnectionClosedCallbackWrapper _cb _ remote_peer_vanished error_ _ = do let remote_peer_vanished' = (/= 0) remote_peer_vanished maybeError_ <- if error_ == nullPtr then return Nothing else do error_' <- (newBoxed GError) error_ return $ Just error_' _cb remote_peer_vanished' maybeError_ onDBusConnectionClosed :: (GObject a, MonadIO m) => a -> DBusConnectionClosedCallback -> m SignalHandlerId onDBusConnectionClosed obj cb = liftIO $ connectDBusConnectionClosed obj cb SignalConnectBefore afterDBusConnectionClosed :: (GObject a, MonadIO m) => a -> DBusConnectionClosedCallback -> m SignalHandlerId afterDBusConnectionClosed obj cb = connectDBusConnectionClosed obj cb SignalConnectAfter connectDBusConnectionClosed :: (GObject a, MonadIO m) => a -> DBusConnectionClosedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusConnectionClosed obj cb after = liftIO $ do cb' <- mkDBusConnectionClosedCallback (dBusConnectionClosedCallbackWrapper cb) connectSignalFunPtr obj "closed" cb' after -- Flags DBusConnectionFlags data DBusConnectionFlags = DBusConnectionFlagsNone | DBusConnectionFlagsAuthenticationClient | DBusConnectionFlagsAuthenticationServer | DBusConnectionFlagsAuthenticationAllowAnonymous | DBusConnectionFlagsMessageBusConnection | DBusConnectionFlagsDelayMessageProcessing | AnotherDBusConnectionFlags Int deriving (Show, Eq) instance Enum DBusConnectionFlags where fromEnum DBusConnectionFlagsNone = 0 fromEnum DBusConnectionFlagsAuthenticationClient = 1 fromEnum DBusConnectionFlagsAuthenticationServer = 2 fromEnum DBusConnectionFlagsAuthenticationAllowAnonymous = 4 fromEnum DBusConnectionFlagsMessageBusConnection = 8 fromEnum DBusConnectionFlagsDelayMessageProcessing = 16 fromEnum (AnotherDBusConnectionFlags k) = k toEnum 0 = DBusConnectionFlagsNone toEnum 1 = DBusConnectionFlagsAuthenticationClient toEnum 2 = DBusConnectionFlagsAuthenticationServer toEnum 4 = DBusConnectionFlagsAuthenticationAllowAnonymous toEnum 8 = DBusConnectionFlagsMessageBusConnection toEnum 16 = DBusConnectionFlagsDelayMessageProcessing toEnum k = AnotherDBusConnectionFlags k foreign import ccall "g_dbus_connection_flags_get_type" c_g_dbus_connection_flags_get_type :: IO GType instance BoxedEnum DBusConnectionFlags where boxedEnumType _ = c_g_dbus_connection_flags_get_type instance IsGFlag DBusConnectionFlags -- Enum DBusError data DBusError = DBusErrorFailed | DBusErrorNoMemory | DBusErrorServiceUnknown | DBusErrorNameHasNoOwner | DBusErrorNoReply | DBusErrorIoError | DBusErrorBadAddress | DBusErrorNotSupported | DBusErrorLimitsExceeded | DBusErrorAccessDenied | DBusErrorAuthFailed | DBusErrorNoServer | DBusErrorTimeout | DBusErrorNoNetwork | DBusErrorAddressInUse | DBusErrorDisconnected | DBusErrorInvalidArgs | DBusErrorFileNotFound | DBusErrorFileExists | DBusErrorUnknownMethod | DBusErrorTimedOut | DBusErrorMatchRuleNotFound | DBusErrorMatchRuleInvalid | DBusErrorSpawnExecFailed | DBusErrorSpawnForkFailed | DBusErrorSpawnChildExited | DBusErrorSpawnChildSignaled | DBusErrorSpawnFailed | DBusErrorSpawnSetupFailed | DBusErrorSpawnConfigInvalid | DBusErrorSpawnServiceInvalid | DBusErrorSpawnServiceNotFound | DBusErrorSpawnPermissionsInvalid | DBusErrorSpawnFileInvalid | DBusErrorSpawnNoMemory | DBusErrorUnixProcessIdUnknown | DBusErrorInvalidSignature | DBusErrorInvalidFileContent | DBusErrorSelinuxSecurityContextUnknown | DBusErrorAdtAuditDataUnknown | DBusErrorObjectPathInUse | DBusErrorUnknownObject | DBusErrorUnknownInterface | DBusErrorUnknownProperty | DBusErrorPropertyReadOnly | AnotherDBusError Int deriving (Show, Eq) instance Enum DBusError where fromEnum DBusErrorFailed = 0 fromEnum DBusErrorNoMemory = 1 fromEnum DBusErrorServiceUnknown = 2 fromEnum DBusErrorNameHasNoOwner = 3 fromEnum DBusErrorNoReply = 4 fromEnum DBusErrorIoError = 5 fromEnum DBusErrorBadAddress = 6 fromEnum DBusErrorNotSupported = 7 fromEnum DBusErrorLimitsExceeded = 8 fromEnum DBusErrorAccessDenied = 9 fromEnum DBusErrorAuthFailed = 10 fromEnum DBusErrorNoServer = 11 fromEnum DBusErrorTimeout = 12 fromEnum DBusErrorNoNetwork = 13 fromEnum DBusErrorAddressInUse = 14 fromEnum DBusErrorDisconnected = 15 fromEnum DBusErrorInvalidArgs = 16 fromEnum DBusErrorFileNotFound = 17 fromEnum DBusErrorFileExists = 18 fromEnum DBusErrorUnknownMethod = 19 fromEnum DBusErrorTimedOut = 20 fromEnum DBusErrorMatchRuleNotFound = 21 fromEnum DBusErrorMatchRuleInvalid = 22 fromEnum DBusErrorSpawnExecFailed = 23 fromEnum DBusErrorSpawnForkFailed = 24 fromEnum DBusErrorSpawnChildExited = 25 fromEnum DBusErrorSpawnChildSignaled = 26 fromEnum DBusErrorSpawnFailed = 27 fromEnum DBusErrorSpawnSetupFailed = 28 fromEnum DBusErrorSpawnConfigInvalid = 29 fromEnum DBusErrorSpawnServiceInvalid = 30 fromEnum DBusErrorSpawnServiceNotFound = 31 fromEnum DBusErrorSpawnPermissionsInvalid = 32 fromEnum DBusErrorSpawnFileInvalid = 33 fromEnum DBusErrorSpawnNoMemory = 34 fromEnum DBusErrorUnixProcessIdUnknown = 35 fromEnum DBusErrorInvalidSignature = 36 fromEnum DBusErrorInvalidFileContent = 37 fromEnum DBusErrorSelinuxSecurityContextUnknown = 38 fromEnum DBusErrorAdtAuditDataUnknown = 39 fromEnum DBusErrorObjectPathInUse = 40 fromEnum DBusErrorUnknownObject = 41 fromEnum DBusErrorUnknownInterface = 42 fromEnum DBusErrorUnknownProperty = 43 fromEnum DBusErrorPropertyReadOnly = 44 fromEnum (AnotherDBusError k) = k toEnum 0 = DBusErrorFailed toEnum 1 = DBusErrorNoMemory toEnum 2 = DBusErrorServiceUnknown toEnum 3 = DBusErrorNameHasNoOwner toEnum 4 = DBusErrorNoReply toEnum 5 = DBusErrorIoError toEnum 6 = DBusErrorBadAddress toEnum 7 = DBusErrorNotSupported toEnum 8 = DBusErrorLimitsExceeded toEnum 9 = DBusErrorAccessDenied toEnum 10 = DBusErrorAuthFailed toEnum 11 = DBusErrorNoServer toEnum 12 = DBusErrorTimeout toEnum 13 = DBusErrorNoNetwork toEnum 14 = DBusErrorAddressInUse toEnum 15 = DBusErrorDisconnected toEnum 16 = DBusErrorInvalidArgs toEnum 17 = DBusErrorFileNotFound toEnum 18 = DBusErrorFileExists toEnum 19 = DBusErrorUnknownMethod toEnum 20 = DBusErrorTimedOut toEnum 21 = DBusErrorMatchRuleNotFound toEnum 22 = DBusErrorMatchRuleInvalid toEnum 23 = DBusErrorSpawnExecFailed toEnum 24 = DBusErrorSpawnForkFailed toEnum 25 = DBusErrorSpawnChildExited toEnum 26 = DBusErrorSpawnChildSignaled toEnum 27 = DBusErrorSpawnFailed toEnum 28 = DBusErrorSpawnSetupFailed toEnum 29 = DBusErrorSpawnConfigInvalid toEnum 30 = DBusErrorSpawnServiceInvalid toEnum 31 = DBusErrorSpawnServiceNotFound toEnum 32 = DBusErrorSpawnPermissionsInvalid toEnum 33 = DBusErrorSpawnFileInvalid toEnum 34 = DBusErrorSpawnNoMemory toEnum 35 = DBusErrorUnixProcessIdUnknown toEnum 36 = DBusErrorInvalidSignature toEnum 37 = DBusErrorInvalidFileContent toEnum 38 = DBusErrorSelinuxSecurityContextUnknown toEnum 39 = DBusErrorAdtAuditDataUnknown toEnum 40 = DBusErrorObjectPathInUse toEnum 41 = DBusErrorUnknownObject toEnum 42 = DBusErrorUnknownInterface toEnum 43 = DBusErrorUnknownProperty toEnum 44 = DBusErrorPropertyReadOnly toEnum k = AnotherDBusError k instance GErrorClass DBusError where gerrorClassDomain _ = "g-dbus-error-quark" catchDBusError :: IO a -> (DBusError -> GErrorMessage -> IO a) -> IO a catchDBusError = catchGErrorJustDomain handleDBusError :: (DBusError -> GErrorMessage -> IO a) -> IO a -> IO a handleDBusError = handleGErrorJustDomain foreign import ccall "g_dbus_error_get_type" c_g_dbus_error_get_type :: IO GType instance BoxedEnum DBusError where boxedEnumType _ = c_g_dbus_error_get_type -- struct DBusErrorEntry newtype DBusErrorEntry = DBusErrorEntry (ForeignPtr DBusErrorEntry) noDBusErrorEntry :: Maybe DBusErrorEntry noDBusErrorEntry = Nothing dBusErrorEntryReadErrorCode :: DBusErrorEntry -> IO Int32 dBusErrorEntryReadErrorCode s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val dBusErrorEntryReadDbusErrorName :: DBusErrorEntry -> IO T.Text dBusErrorEntryReadDbusErrorName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' -- interface DBusInterface newtype DBusInterface = DBusInterface (ForeignPtr DBusInterface) noDBusInterface :: Maybe DBusInterface noDBusInterface = Nothing foreign import ccall "g_dbus_interface_get_type" c_g_dbus_interface_get_type :: IO GType type instance ParentTypes DBusInterface = '[GObject.Object] instance GObject DBusInterface where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_interface_get_type class GObject o => DBusInterfaceK o instance (GObject o, IsDescendantOf DBusInterface o) => DBusInterfaceK o toDBusInterface :: DBusInterfaceK o => o -> IO DBusInterface toDBusInterface = unsafeCastTo DBusInterface -- method DBusInterface::get_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObject" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_dup_object" g_dbus_interface_dup_object :: Ptr DBusInterface -> -- _obj : TInterface "Gio" "DBusInterface" IO (Ptr DBusObject) dBusInterfaceGetObject :: (MonadIO m, DBusInterfaceK a) => a -> -- _obj m DBusObject dBusInterfaceGetObject _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_interface_dup_object _obj' checkUnexpectedReturnNULL "g_dbus_interface_dup_object" result result' <- (wrapObject DBusObject) result touchManagedPtr _obj return result' -- method DBusInterface::get_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusInterfaceInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_get_info" g_dbus_interface_get_info :: Ptr DBusInterface -> -- _obj : TInterface "Gio" "DBusInterface" IO (Ptr DBusInterfaceInfo) dBusInterfaceGetInfo :: (MonadIO m, DBusInterfaceK a) => a -> -- _obj m DBusInterfaceInfo dBusInterfaceGetInfo _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_interface_get_info _obj' checkUnexpectedReturnNULL "g_dbus_interface_get_info" result result' <- (newBoxed DBusInterfaceInfo) result touchManagedPtr _obj return result' -- method DBusInterface::set_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_set_object" g_dbus_interface_set_object :: Ptr DBusInterface -> -- _obj : TInterface "Gio" "DBusInterface" Ptr DBusObject -> -- object : TInterface "Gio" "DBusObject" IO () dBusInterfaceSetObject :: (MonadIO m, DBusInterfaceK a, DBusObjectK b) => a -> -- _obj Maybe (b) -> -- object m () dBusInterfaceSetObject _obj object = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeObject <- case object of Nothing -> return nullPtr Just jObject -> do let jObject' = unsafeManagedPtrCastPtr jObject return jObject' g_dbus_interface_set_object _obj' maybeObject touchManagedPtr _obj whenJust object touchManagedPtr return () -- callback DBusInterfaceGetPropertyFunc dBusInterfaceGetPropertyFuncClosure :: DBusInterfaceGetPropertyFunc -> IO Closure dBusInterfaceGetPropertyFuncClosure cb = newCClosure =<< mkDBusInterfaceGetPropertyFunc wrapped where wrapped = dBusInterfaceGetPropertyFuncWrapper Nothing cb type DBusInterfaceGetPropertyFuncC = Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr GError -> Ptr () -> IO (Ptr GVariant) foreign import ccall "wrapper" mkDBusInterfaceGetPropertyFunc :: DBusInterfaceGetPropertyFuncC -> IO (FunPtr DBusInterfaceGetPropertyFuncC) type DBusInterfaceGetPropertyFunc = DBusConnection -> T.Text -> T.Text -> T.Text -> T.Text -> GError -> IO GVariant noDBusInterfaceGetPropertyFunc :: Maybe DBusInterfaceGetPropertyFunc noDBusInterfaceGetPropertyFunc = Nothing dBusInterfaceGetPropertyFuncWrapper :: Maybe (Ptr (FunPtr (DBusInterfaceGetPropertyFuncC))) -> DBusInterfaceGetPropertyFunc -> Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr GError -> Ptr () -> IO (Ptr GVariant) dBusInterfaceGetPropertyFuncWrapper funptrptr _cb connection sender object_path interface_name property_name error_ _ = do connection' <- (newObject DBusConnection) connection sender' <- cstringToText sender object_path' <- cstringToText object_path interface_name' <- cstringToText interface_name property_name' <- cstringToText property_name error_' <- (newBoxed GError) error_ result <- _cb connection' sender' object_path' interface_name' property_name' error_' maybeReleaseFunPtr funptrptr result' <- refGVariant result return result' -- struct DBusInterfaceInfo newtype DBusInterfaceInfo = DBusInterfaceInfo (ForeignPtr DBusInterfaceInfo) noDBusInterfaceInfo :: Maybe DBusInterfaceInfo noDBusInterfaceInfo = Nothing foreign import ccall "g_dbus_interface_info_get_type" c_g_dbus_interface_info_get_type :: IO GType instance BoxedObject DBusInterfaceInfo where boxedType _ = c_g_dbus_interface_info_get_type dBusInterfaceInfoReadRefCount :: DBusInterfaceInfo -> IO Int32 dBusInterfaceInfoReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val dBusInterfaceInfoReadName :: DBusInterfaceInfo -> IO T.Text dBusInterfaceInfoReadName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' dBusInterfaceInfoReadMethods :: DBusInterfaceInfo -> IO [DBusMethodInfo] dBusInterfaceInfoReadMethods s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr (Ptr DBusMethodInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusMethodInfo) val' return val'' dBusInterfaceInfoReadSignals :: DBusInterfaceInfo -> IO [DBusSignalInfo] dBusInterfaceInfoReadSignals s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr (Ptr DBusSignalInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusSignalInfo) val' return val'' dBusInterfaceInfoReadProperties :: DBusInterfaceInfo -> IO [DBusPropertyInfo] dBusInterfaceInfoReadProperties s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO (Ptr (Ptr DBusPropertyInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusPropertyInfo) val' return val'' dBusInterfaceInfoReadAnnotations :: DBusInterfaceInfo -> IO [DBusAnnotationInfo] dBusInterfaceInfoReadAnnotations s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO (Ptr (Ptr DBusAnnotationInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusAnnotationInfo) val' return val'' -- method DBusInterfaceInfo::cache_build -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_info_cache_build" g_dbus_interface_info_cache_build :: Ptr DBusInterfaceInfo -> -- _obj : TInterface "Gio" "DBusInterfaceInfo" IO () dBusInterfaceInfoCacheBuild :: (MonadIO m) => DBusInterfaceInfo -> -- _obj m () dBusInterfaceInfoCacheBuild _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_interface_info_cache_build _obj' touchManagedPtr _obj return () -- method DBusInterfaceInfo::cache_release -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_info_cache_release" g_dbus_interface_info_cache_release :: Ptr DBusInterfaceInfo -> -- _obj : TInterface "Gio" "DBusInterfaceInfo" IO () dBusInterfaceInfoCacheRelease :: (MonadIO m) => DBusInterfaceInfo -> -- _obj m () dBusInterfaceInfoCacheRelease _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_interface_info_cache_release _obj' touchManagedPtr _obj return () -- method DBusInterfaceInfo::generate_xml -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "indent", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_builder", argType = TInterface "GLib" "String", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "indent", 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_dbus_interface_info_generate_xml" g_dbus_interface_info_generate_xml :: Ptr DBusInterfaceInfo -> -- _obj : TInterface "Gio" "DBusInterfaceInfo" Word32 -> -- indent : TBasicType TUInt32 Ptr GLib.String -> -- string_builder : TInterface "GLib" "String" IO () dBusInterfaceInfoGenerateXml :: (MonadIO m) => DBusInterfaceInfo -> -- _obj Word32 -> -- indent m (GLib.String) dBusInterfaceInfoGenerateXml _obj indent = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string_builder <- callocBoxedBytes 24 :: IO (Ptr GLib.String) g_dbus_interface_info_generate_xml _obj' indent string_builder string_builder' <- (wrapBoxed GLib.String) string_builder touchManagedPtr _obj return string_builder' -- method DBusInterfaceInfo::lookup_method -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", 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 "Gio" "DBusInterfaceInfo", 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 : TInterface "Gio" "DBusMethodInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_info_lookup_method" g_dbus_interface_info_lookup_method :: Ptr DBusInterfaceInfo -> -- _obj : TInterface "Gio" "DBusInterfaceInfo" CString -> -- name : TBasicType TUTF8 IO (Ptr DBusMethodInfo) dBusInterfaceInfoLookupMethod :: (MonadIO m) => DBusInterfaceInfo -> -- _obj T.Text -> -- name m DBusMethodInfo dBusInterfaceInfoLookupMethod _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_dbus_interface_info_lookup_method _obj' name' checkUnexpectedReturnNULL "g_dbus_interface_info_lookup_method" result result' <- (newBoxed DBusMethodInfo) result touchManagedPtr _obj freeMem name' return result' -- method DBusInterfaceInfo::lookup_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", 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 "Gio" "DBusInterfaceInfo", 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 : TInterface "Gio" "DBusPropertyInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_info_lookup_property" g_dbus_interface_info_lookup_property :: Ptr DBusInterfaceInfo -> -- _obj : TInterface "Gio" "DBusInterfaceInfo" CString -> -- name : TBasicType TUTF8 IO (Ptr DBusPropertyInfo) dBusInterfaceInfoLookupProperty :: (MonadIO m) => DBusInterfaceInfo -> -- _obj T.Text -> -- name m DBusPropertyInfo dBusInterfaceInfoLookupProperty _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_dbus_interface_info_lookup_property _obj' name' checkUnexpectedReturnNULL "g_dbus_interface_info_lookup_property" result result' <- (newBoxed DBusPropertyInfo) result touchManagedPtr _obj freeMem name' return result' -- method DBusInterfaceInfo::lookup_signal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", 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 "Gio" "DBusInterfaceInfo", 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 : TInterface "Gio" "DBusSignalInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_info_lookup_signal" g_dbus_interface_info_lookup_signal :: Ptr DBusInterfaceInfo -> -- _obj : TInterface "Gio" "DBusInterfaceInfo" CString -> -- name : TBasicType TUTF8 IO (Ptr DBusSignalInfo) dBusInterfaceInfoLookupSignal :: (MonadIO m) => DBusInterfaceInfo -> -- _obj T.Text -> -- name m DBusSignalInfo dBusInterfaceInfoLookupSignal _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_dbus_interface_info_lookup_signal _obj' name' checkUnexpectedReturnNULL "g_dbus_interface_info_lookup_signal" result result' <- (newBoxed DBusSignalInfo) result touchManagedPtr _obj freeMem name' return result' -- method DBusInterfaceInfo::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusInterfaceInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_info_ref" g_dbus_interface_info_ref :: Ptr DBusInterfaceInfo -> -- _obj : TInterface "Gio" "DBusInterfaceInfo" IO (Ptr DBusInterfaceInfo) dBusInterfaceInfoRef :: (MonadIO m) => DBusInterfaceInfo -> -- _obj m DBusInterfaceInfo dBusInterfaceInfoRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_dbus_interface_info_ref _obj' checkUnexpectedReturnNULL "g_dbus_interface_info_ref" result result' <- (wrapBoxed DBusInterfaceInfo) result touchManagedPtr _obj return result' -- method DBusInterfaceInfo::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_info_unref" g_dbus_interface_info_unref :: Ptr DBusInterfaceInfo -> -- _obj : TInterface "Gio" "DBusInterfaceInfo" IO () dBusInterfaceInfoUnref :: (MonadIO m) => DBusInterfaceInfo -> -- _obj m () dBusInterfaceInfoUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_interface_info_unref _obj' touchManagedPtr _obj return () -- callback DBusInterfaceMethodCallFunc dBusInterfaceMethodCallFuncClosure :: DBusInterfaceMethodCallFunc -> IO Closure dBusInterfaceMethodCallFuncClosure cb = newCClosure =<< mkDBusInterfaceMethodCallFunc wrapped where wrapped = dBusInterfaceMethodCallFuncWrapper Nothing cb type DBusInterfaceMethodCallFuncC = Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr GVariant -> Ptr DBusMethodInvocation -> Ptr () -> IO () foreign import ccall "wrapper" mkDBusInterfaceMethodCallFunc :: DBusInterfaceMethodCallFuncC -> IO (FunPtr DBusInterfaceMethodCallFuncC) type DBusInterfaceMethodCallFunc = DBusConnection -> T.Text -> T.Text -> T.Text -> T.Text -> GVariant -> DBusMethodInvocation -> IO () noDBusInterfaceMethodCallFunc :: Maybe DBusInterfaceMethodCallFunc noDBusInterfaceMethodCallFunc = Nothing dBusInterfaceMethodCallFuncWrapper :: Maybe (Ptr (FunPtr (DBusInterfaceMethodCallFuncC))) -> DBusInterfaceMethodCallFunc -> Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr GVariant -> Ptr DBusMethodInvocation -> Ptr () -> IO () dBusInterfaceMethodCallFuncWrapper funptrptr _cb connection sender object_path interface_name method_name parameters invocation _ = do connection' <- (newObject DBusConnection) connection sender' <- cstringToText sender object_path' <- cstringToText object_path interface_name' <- cstringToText interface_name method_name' <- cstringToText method_name parameters' <- newGVariantFromPtr parameters invocation' <- (wrapObject DBusMethodInvocation) invocation _cb connection' sender' object_path' interface_name' method_name' parameters' invocation' maybeReleaseFunPtr funptrptr -- callback DBusInterfaceSetPropertyFunc dBusInterfaceSetPropertyFuncClosure :: DBusInterfaceSetPropertyFunc -> IO Closure dBusInterfaceSetPropertyFuncClosure cb = newCClosure =<< mkDBusInterfaceSetPropertyFunc wrapped where wrapped = dBusInterfaceSetPropertyFuncWrapper Nothing cb type DBusInterfaceSetPropertyFuncC = Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr GVariant -> Ptr GError -> Ptr () -> IO CInt foreign import ccall "wrapper" mkDBusInterfaceSetPropertyFunc :: DBusInterfaceSetPropertyFuncC -> IO (FunPtr DBusInterfaceSetPropertyFuncC) type DBusInterfaceSetPropertyFunc = DBusConnection -> T.Text -> T.Text -> T.Text -> T.Text -> GVariant -> GError -> IO Bool noDBusInterfaceSetPropertyFunc :: Maybe DBusInterfaceSetPropertyFunc noDBusInterfaceSetPropertyFunc = Nothing dBusInterfaceSetPropertyFuncWrapper :: Maybe (Ptr (FunPtr (DBusInterfaceSetPropertyFuncC))) -> DBusInterfaceSetPropertyFunc -> Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr GVariant -> Ptr GError -> Ptr () -> IO CInt dBusInterfaceSetPropertyFuncWrapper funptrptr _cb connection sender object_path interface_name property_name value error_ _ = do connection' <- (newObject DBusConnection) connection sender' <- cstringToText sender object_path' <- cstringToText object_path interface_name' <- cstringToText interface_name property_name' <- cstringToText property_name value' <- newGVariantFromPtr value error_' <- (newBoxed GError) error_ result <- _cb connection' sender' object_path' interface_name' property_name' value' error_' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- object DBusInterfaceSkeleton newtype DBusInterfaceSkeleton = DBusInterfaceSkeleton (ForeignPtr DBusInterfaceSkeleton) noDBusInterfaceSkeleton :: Maybe DBusInterfaceSkeleton noDBusInterfaceSkeleton = Nothing foreign import ccall "g_dbus_interface_skeleton_get_type" c_g_dbus_interface_skeleton_get_type :: IO GType type instance ParentTypes DBusInterfaceSkeleton = '[GObject.Object, DBusInterface] instance GObject DBusInterfaceSkeleton where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_interface_skeleton_get_type class GObject o => DBusInterfaceSkeletonK o instance (GObject o, IsDescendantOf DBusInterfaceSkeleton o) => DBusInterfaceSkeletonK o toDBusInterfaceSkeleton :: DBusInterfaceSkeletonK o => o -> IO DBusInterfaceSkeleton toDBusInterfaceSkeleton = unsafeCastTo DBusInterfaceSkeleton -- method DBusInterfaceSkeleton::export -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", 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_dbus_interface_skeleton_export" g_dbus_interface_skeleton_export :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CString -> -- object_path : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt dBusInterfaceSkeletonExport :: (MonadIO m, DBusInterfaceSkeletonK a, DBusConnectionK b) => a -> -- _obj b -> -- connection T.Text -> -- object_path m () dBusInterfaceSkeletonExport _obj connection object_path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connection' = unsafeManagedPtrCastPtr connection object_path' <- textToCString object_path onException (do _ <- propagateGError $ g_dbus_interface_skeleton_export _obj' connection' object_path' touchManagedPtr _obj touchManagedPtr connection freeMem object_path' return () ) (do freeMem object_path' ) -- method DBusInterfaceSkeleton::flush -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_flush" g_dbus_interface_skeleton_flush :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" IO () dBusInterfaceSkeletonFlush :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj m () dBusInterfaceSkeletonFlush _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_interface_skeleton_flush _obj' touchManagedPtr _obj return () -- method DBusInterfaceSkeleton::get_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_get_connection" g_dbus_interface_skeleton_get_connection :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" IO (Ptr DBusConnection) dBusInterfaceSkeletonGetConnection :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj m DBusConnection dBusInterfaceSkeletonGetConnection _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_interface_skeleton_get_connection _obj' checkUnexpectedReturnNULL "g_dbus_interface_skeleton_get_connection" result result' <- (newObject DBusConnection) result touchManagedPtr _obj return result' -- method DBusInterfaceSkeleton::get_connections -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "DBusConnection") -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_get_connections" g_dbus_interface_skeleton_get_connections :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" IO (Ptr (GList (Ptr DBusConnection))) dBusInterfaceSkeletonGetConnections :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj m [DBusConnection] dBusInterfaceSkeletonGetConnections _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_interface_skeleton_get_connections _obj' checkUnexpectedReturnNULL "g_dbus_interface_skeleton_get_connections" result result' <- unpackGList result result'' <- mapM (wrapObject DBusConnection) result' g_list_free result touchManagedPtr _obj return result'' -- method DBusInterfaceSkeleton::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusInterfaceSkeletonFlags" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_get_flags" g_dbus_interface_skeleton_get_flags :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" IO CUInt dBusInterfaceSkeletonGetFlags :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj m [DBusInterfaceSkeletonFlags] dBusInterfaceSkeletonGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_interface_skeleton_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method DBusInterfaceSkeleton::get_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusInterfaceInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_get_info" g_dbus_interface_skeleton_get_info :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" IO (Ptr DBusInterfaceInfo) dBusInterfaceSkeletonGetInfo :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj m DBusInterfaceInfo dBusInterfaceSkeletonGetInfo _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_interface_skeleton_get_info _obj' checkUnexpectedReturnNULL "g_dbus_interface_skeleton_get_info" result result' <- (newBoxed DBusInterfaceInfo) result touchManagedPtr _obj return result' -- method DBusInterfaceSkeleton::get_object_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_get_object_path" g_dbus_interface_skeleton_get_object_path :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" IO CString dBusInterfaceSkeletonGetObjectPath :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj m T.Text dBusInterfaceSkeletonGetObjectPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_interface_skeleton_get_object_path _obj' checkUnexpectedReturnNULL "g_dbus_interface_skeleton_get_object_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusInterfaceSkeleton::get_properties -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_get_properties" g_dbus_interface_skeleton_get_properties :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" IO (Ptr GVariant) dBusInterfaceSkeletonGetProperties :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj m GVariant dBusInterfaceSkeletonGetProperties _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_interface_skeleton_get_properties _obj' checkUnexpectedReturnNULL "g_dbus_interface_skeleton_get_properties" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method DBusInterfaceSkeleton::has_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_has_connection" g_dbus_interface_skeleton_has_connection :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" IO CInt dBusInterfaceSkeletonHasConnection :: (MonadIO m, DBusInterfaceSkeletonK a, DBusConnectionK b) => a -> -- _obj b -> -- connection m Bool dBusInterfaceSkeletonHasConnection _obj connection = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connection' = unsafeManagedPtrCastPtr connection result <- g_dbus_interface_skeleton_has_connection _obj' connection' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr connection return result' -- method DBusInterfaceSkeleton::set_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusInterfaceSkeletonFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusInterfaceSkeletonFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_set_flags" g_dbus_interface_skeleton_set_flags :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" CUInt -> -- flags : TInterface "Gio" "DBusInterfaceSkeletonFlags" IO () dBusInterfaceSkeletonSetFlags :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj [DBusInterfaceSkeletonFlags] -> -- flags m () dBusInterfaceSkeletonSetFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags g_dbus_interface_skeleton_set_flags _obj' flags' touchManagedPtr _obj return () -- method DBusInterfaceSkeleton::unexport -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_unexport" g_dbus_interface_skeleton_unexport :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" IO () dBusInterfaceSkeletonUnexport :: (MonadIO m, DBusInterfaceSkeletonK a) => a -> -- _obj m () dBusInterfaceSkeletonUnexport _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_interface_skeleton_unexport _obj' touchManagedPtr _obj return () -- method DBusInterfaceSkeleton::unexport_from_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_interface_skeleton_unexport_from_connection" g_dbus_interface_skeleton_unexport_from_connection :: Ptr DBusInterfaceSkeleton -> -- _obj : TInterface "Gio" "DBusInterfaceSkeleton" Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" IO () dBusInterfaceSkeletonUnexportFromConnection :: (MonadIO m, DBusInterfaceSkeletonK a, DBusConnectionK b) => a -> -- _obj b -> -- connection m () dBusInterfaceSkeletonUnexportFromConnection _obj connection = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connection' = unsafeManagedPtrCastPtr connection g_dbus_interface_skeleton_unexport_from_connection _obj' connection' touchManagedPtr _obj touchManagedPtr connection return () -- signal DBusInterfaceSkeleton::g-authorize-method type DBusInterfaceSkeletonGAuthorizeMethodCallback = DBusMethodInvocation -> IO Bool noDBusInterfaceSkeletonGAuthorizeMethodCallback :: Maybe DBusInterfaceSkeletonGAuthorizeMethodCallback noDBusInterfaceSkeletonGAuthorizeMethodCallback = Nothing type DBusInterfaceSkeletonGAuthorizeMethodCallbackC = Ptr () -> -- object Ptr DBusMethodInvocation -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkDBusInterfaceSkeletonGAuthorizeMethodCallback :: DBusInterfaceSkeletonGAuthorizeMethodCallbackC -> IO (FunPtr DBusInterfaceSkeletonGAuthorizeMethodCallbackC) dBusInterfaceSkeletonGAuthorizeMethodClosure :: DBusInterfaceSkeletonGAuthorizeMethodCallback -> IO Closure dBusInterfaceSkeletonGAuthorizeMethodClosure cb = newCClosure =<< mkDBusInterfaceSkeletonGAuthorizeMethodCallback wrapped where wrapped = dBusInterfaceSkeletonGAuthorizeMethodCallbackWrapper cb dBusInterfaceSkeletonGAuthorizeMethodCallbackWrapper :: DBusInterfaceSkeletonGAuthorizeMethodCallback -> Ptr () -> Ptr DBusMethodInvocation -> Ptr () -> IO CInt dBusInterfaceSkeletonGAuthorizeMethodCallbackWrapper _cb _ invocation _ = do invocation' <- (newObject DBusMethodInvocation) invocation result <- _cb invocation' let result' = (fromIntegral . fromEnum) result return result' onDBusInterfaceSkeletonGAuthorizeMethod :: (GObject a, MonadIO m) => a -> DBusInterfaceSkeletonGAuthorizeMethodCallback -> m SignalHandlerId onDBusInterfaceSkeletonGAuthorizeMethod obj cb = liftIO $ connectDBusInterfaceSkeletonGAuthorizeMethod obj cb SignalConnectBefore afterDBusInterfaceSkeletonGAuthorizeMethod :: (GObject a, MonadIO m) => a -> DBusInterfaceSkeletonGAuthorizeMethodCallback -> m SignalHandlerId afterDBusInterfaceSkeletonGAuthorizeMethod obj cb = connectDBusInterfaceSkeletonGAuthorizeMethod obj cb SignalConnectAfter connectDBusInterfaceSkeletonGAuthorizeMethod :: (GObject a, MonadIO m) => a -> DBusInterfaceSkeletonGAuthorizeMethodCallback -> SignalConnectMode -> m SignalHandlerId connectDBusInterfaceSkeletonGAuthorizeMethod obj cb after = liftIO $ do cb' <- mkDBusInterfaceSkeletonGAuthorizeMethodCallback (dBusInterfaceSkeletonGAuthorizeMethodCallbackWrapper cb) connectSignalFunPtr obj "g-authorize-method" cb' after -- Flags DBusInterfaceSkeletonFlags data DBusInterfaceSkeletonFlags = DBusInterfaceSkeletonFlagsNone | DBusInterfaceSkeletonFlagsHandleMethodInvocationsInThread | AnotherDBusInterfaceSkeletonFlags Int deriving (Show, Eq) instance Enum DBusInterfaceSkeletonFlags where fromEnum DBusInterfaceSkeletonFlagsNone = 0 fromEnum DBusInterfaceSkeletonFlagsHandleMethodInvocationsInThread = 1 fromEnum (AnotherDBusInterfaceSkeletonFlags k) = k toEnum 0 = DBusInterfaceSkeletonFlagsNone toEnum 1 = DBusInterfaceSkeletonFlagsHandleMethodInvocationsInThread toEnum k = AnotherDBusInterfaceSkeletonFlags k foreign import ccall "g_dbus_interface_skeleton_flags_get_type" c_g_dbus_interface_skeleton_flags_get_type :: IO GType instance BoxedEnum DBusInterfaceSkeletonFlags where boxedEnumType _ = c_g_dbus_interface_skeleton_flags_get_type instance IsGFlag DBusInterfaceSkeletonFlags -- struct DBusInterfaceVTable newtype DBusInterfaceVTable = DBusInterfaceVTable (ForeignPtr DBusInterfaceVTable) noDBusInterfaceVTable :: Maybe DBusInterfaceVTable noDBusInterfaceVTable = Nothing -- XXX Skipped getter for "DBusInterfaceVTable:method_call" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "DBusInterfaceVTable:get_property" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "DBusInterfaceVTable:set_property" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- object DBusMenuModel newtype DBusMenuModel = DBusMenuModel (ForeignPtr DBusMenuModel) noDBusMenuModel :: Maybe DBusMenuModel noDBusMenuModel = Nothing foreign import ccall "g_dbus_menu_model_get_type" c_g_dbus_menu_model_get_type :: IO GType type instance ParentTypes DBusMenuModel = '[MenuModel, GObject.Object] instance GObject DBusMenuModel where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_menu_model_get_type class GObject o => DBusMenuModelK o instance (GObject o, IsDescendantOf DBusMenuModel o) => DBusMenuModelK o toDBusMenuModel :: DBusMenuModelK o => o -> IO DBusMenuModel toDBusMenuModel = unsafeCastTo DBusMenuModel -- method DBusMenuModel::get -- method type : MemberFunction -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMenuModel" -- throws : False -- Skip return : False foreign import ccall "g_dbus_menu_model_get" g_dbus_menu_model_get :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CString -> -- bus_name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 IO (Ptr DBusMenuModel) dBusMenuModelGet :: (MonadIO m, DBusConnectionK a) => a -> -- connection T.Text -> -- bus_name T.Text -> -- object_path m DBusMenuModel dBusMenuModelGet connection bus_name object_path = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection bus_name' <- textToCString bus_name object_path' <- textToCString object_path result <- g_dbus_menu_model_get connection' bus_name' object_path' checkUnexpectedReturnNULL "g_dbus_menu_model_get" result result' <- (wrapObject DBusMenuModel) result touchManagedPtr connection freeMem bus_name' freeMem object_path' return result' -- object DBusMessage newtype DBusMessage = DBusMessage (ForeignPtr DBusMessage) noDBusMessage :: Maybe DBusMessage noDBusMessage = Nothing foreign import ccall "g_dbus_message_get_type" c_g_dbus_message_get_type :: IO GType type instance ParentTypes DBusMessage = '[GObject.Object] instance GObject DBusMessage where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_message_get_type class GObject o => DBusMessageK o instance (GObject o, IsDescendantOf DBusMessage o) => DBusMessageK o toDBusMessage :: DBusMessageK o => o -> IO DBusMessage toDBusMessage = unsafeCastTo DBusMessage -- method DBusMessage::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "DBusMessage" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_new" g_dbus_message_new :: IO (Ptr DBusMessage) dBusMessageNew :: (MonadIO m) => m DBusMessage dBusMessageNew = liftIO $ do result <- g_dbus_message_new checkUnexpectedReturnNULL "g_dbus_message_new" result result' <- (wrapObject DBusMessage) result return result' -- method DBusMessage::new_from_blob -- method type : Constructor -- Args : [Arg {argName = "blob", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blob_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "capabilities", argType = TInterface "Gio" "DBusCapabilityFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "blob_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "blob", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "capabilities", argType = TInterface "Gio" "DBusCapabilityFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : True -- Skip return : False foreign import ccall "g_dbus_message_new_from_blob" g_dbus_message_new_from_blob :: Ptr Word8 -> -- blob : TCArray False (-1) 1 (TBasicType TUInt8) Word64 -> -- blob_len : TBasicType TUInt64 CUInt -> -- capabilities : TInterface "Gio" "DBusCapabilityFlags" Ptr (Ptr GError) -> -- error IO (Ptr DBusMessage) dBusMessageNewFromBlob :: (MonadIO m) => ByteString -> -- blob [DBusCapabilityFlags] -> -- capabilities m DBusMessage dBusMessageNewFromBlob blob capabilities = liftIO $ do let blob_len = fromIntegral $ B.length blob blob' <- packByteString blob let capabilities' = gflagsToWord capabilities onException (do result <- propagateGError $ g_dbus_message_new_from_blob blob' blob_len capabilities' checkUnexpectedReturnNULL "g_dbus_message_new_from_blob" result result' <- (wrapObject DBusMessage) result freeMem blob' return result' ) (do freeMem blob' ) -- method DBusMessage::new_method_call -- method type : Constructor -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_new_method_call" g_dbus_message_new_method_call :: CString -> -- name : TBasicType TUTF8 CString -> -- path : TBasicType TUTF8 CString -> -- interface_ : TBasicType TUTF8 CString -> -- method : TBasicType TUTF8 IO (Ptr DBusMessage) dBusMessageNewMethodCall :: (MonadIO m) => Maybe (T.Text) -> -- name T.Text -> -- path Maybe (T.Text) -> -- interface_ T.Text -> -- method m DBusMessage dBusMessageNewMethodCall name path interface_ method = liftIO $ do maybeName <- case name of Nothing -> return nullPtr Just jName -> do jName' <- textToCString jName return jName' path' <- textToCString path maybeInterface_ <- case interface_ of Nothing -> return nullPtr Just jInterface_ -> do jInterface_' <- textToCString jInterface_ return jInterface_' method' <- textToCString method result <- g_dbus_message_new_method_call maybeName path' maybeInterface_ method' checkUnexpectedReturnNULL "g_dbus_message_new_method_call" result result' <- (wrapObject DBusMessage) result freeMem maybeName freeMem path' freeMem maybeInterface_ freeMem method' return result' -- method DBusMessage::new_signal -- method type : Constructor -- Args : [Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal", 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},Arg {argName = "interface_", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_new_signal" g_dbus_message_new_signal :: CString -> -- path : TBasicType TUTF8 CString -> -- interface_ : TBasicType TUTF8 CString -> -- signal : TBasicType TUTF8 IO (Ptr DBusMessage) dBusMessageNewSignal :: (MonadIO m) => T.Text -> -- path T.Text -> -- interface_ T.Text -> -- signal m DBusMessage dBusMessageNewSignal path interface_ signal = liftIO $ do path' <- textToCString path interface_' <- textToCString interface_ signal' <- textToCString signal result <- g_dbus_message_new_signal path' interface_' signal' checkUnexpectedReturnNULL "g_dbus_message_new_signal" result result' <- (wrapObject DBusMessage) result freeMem path' freeMem interface_' freeMem signal' return result' -- method DBusMessage::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : True -- Skip return : False foreign import ccall "g_dbus_message_copy" g_dbus_message_copy :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Ptr (Ptr GError) -> -- error IO (Ptr DBusMessage) dBusMessageCopy :: (MonadIO m, DBusMessageK a) => a -> -- _obj m DBusMessage dBusMessageCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_dbus_message_copy _obj' checkUnexpectedReturnNULL "g_dbus_message_copy" result result' <- (wrapObject DBusMessage) result touchManagedPtr _obj return result' ) (do return () ) -- method DBusMessage::get_arg0 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_arg0" g_dbus_message_get_arg0 :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CString dBusMessageGetArg0 :: (MonadIO m, DBusMessageK a) => a -> -- _obj m T.Text dBusMessageGetArg0 _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_arg0 _obj' checkUnexpectedReturnNULL "g_dbus_message_get_arg0" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMessage::get_body -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_body" g_dbus_message_get_body :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO (Ptr GVariant) dBusMessageGetBody :: (MonadIO m, DBusMessageK a) => a -> -- _obj m GVariant dBusMessageGetBody _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_body _obj' checkUnexpectedReturnNULL "g_dbus_message_get_body" result result' <- newGVariantFromPtr result touchManagedPtr _obj return result' -- method DBusMessage::get_byte_order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessageByteOrder" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_byte_order" g_dbus_message_get_byte_order :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CUInt dBusMessageGetByteOrder :: (MonadIO m, DBusMessageK a) => a -> -- _obj m DBusMessageByteOrder dBusMessageGetByteOrder _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_byte_order _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method DBusMessage::get_destination -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_destination" g_dbus_message_get_destination :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CString dBusMessageGetDestination :: (MonadIO m, DBusMessageK a) => a -> -- _obj m T.Text dBusMessageGetDestination _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_destination _obj' checkUnexpectedReturnNULL "g_dbus_message_get_destination" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMessage::get_error_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_error_name" g_dbus_message_get_error_name :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CString dBusMessageGetErrorName :: (MonadIO m, DBusMessageK a) => a -> -- _obj m T.Text dBusMessageGetErrorName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_error_name _obj' checkUnexpectedReturnNULL "g_dbus_message_get_error_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMessage::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessageFlags" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_flags" g_dbus_message_get_flags :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CUInt dBusMessageGetFlags :: (MonadIO m, DBusMessageK a) => a -> -- _obj m [DBusMessageFlags] dBusMessageGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method DBusMessage::get_header -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "header_field", argType = TInterface "Gio" "DBusMessageHeaderField", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "header_field", argType = TInterface "Gio" "DBusMessageHeaderField", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_header" g_dbus_message_get_header :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CUInt -> -- header_field : TInterface "Gio" "DBusMessageHeaderField" IO (Ptr GVariant) dBusMessageGetHeader :: (MonadIO m, DBusMessageK a) => a -> -- _obj DBusMessageHeaderField -> -- header_field m GVariant dBusMessageGetHeader _obj header_field = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let header_field' = (fromIntegral . fromEnum) header_field result <- g_dbus_message_get_header _obj' header_field' checkUnexpectedReturnNULL "g_dbus_message_get_header" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method DBusMessage::get_header_fields -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUInt8) -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_header_fields" g_dbus_message_get_header_fields :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO (Ptr Word8) dBusMessageGetHeaderFields :: (MonadIO m, DBusMessageK a) => a -> -- _obj m ByteString dBusMessageGetHeaderFields _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_header_fields _obj' checkUnexpectedReturnNULL "g_dbus_message_get_header_fields" result result' <- unpackZeroTerminatedByteString result touchManagedPtr _obj return result' -- method DBusMessage::get_interface -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_interface" g_dbus_message_get_interface :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CString dBusMessageGetInterface :: (MonadIO m, DBusMessageK a) => a -> -- _obj m T.Text dBusMessageGetInterface _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_interface _obj' checkUnexpectedReturnNULL "g_dbus_message_get_interface" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMessage::get_locked -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_locked" g_dbus_message_get_locked :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CInt dBusMessageGetLocked :: (MonadIO m, DBusMessageK a) => a -> -- _obj m Bool dBusMessageGetLocked _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_locked _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method DBusMessage::get_member -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_member" g_dbus_message_get_member :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CString dBusMessageGetMember :: (MonadIO m, DBusMessageK a) => a -> -- _obj m T.Text dBusMessageGetMember _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_member _obj' checkUnexpectedReturnNULL "g_dbus_message_get_member" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMessage::get_message_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessageType" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_message_type" g_dbus_message_get_message_type :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CUInt dBusMessageGetMessageType :: (MonadIO m, DBusMessageK a) => a -> -- _obj m DBusMessageType dBusMessageGetMessageType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_message_type _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method DBusMessage::get_num_unix_fds -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_num_unix_fds" g_dbus_message_get_num_unix_fds :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO Word32 dBusMessageGetNumUnixFds :: (MonadIO m, DBusMessageK a) => a -> -- _obj m Word32 dBusMessageGetNumUnixFds _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_num_unix_fds _obj' touchManagedPtr _obj return result -- method DBusMessage::get_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_path" g_dbus_message_get_path :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CString dBusMessageGetPath :: (MonadIO m, DBusMessageK a) => a -> -- _obj m T.Text dBusMessageGetPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_path _obj' checkUnexpectedReturnNULL "g_dbus_message_get_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMessage::get_reply_serial -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_reply_serial" g_dbus_message_get_reply_serial :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO Word32 dBusMessageGetReplySerial :: (MonadIO m, DBusMessageK a) => a -> -- _obj m Word32 dBusMessageGetReplySerial _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_reply_serial _obj' touchManagedPtr _obj return result -- method DBusMessage::get_sender -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_sender" g_dbus_message_get_sender :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CString dBusMessageGetSender :: (MonadIO m, DBusMessageK a) => a -> -- _obj m T.Text dBusMessageGetSender _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_sender _obj' checkUnexpectedReturnNULL "g_dbus_message_get_sender" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMessage::get_serial -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_serial" g_dbus_message_get_serial :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO Word32 dBusMessageGetSerial :: (MonadIO m, DBusMessageK a) => a -> -- _obj m Word32 dBusMessageGetSerial _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_serial _obj' touchManagedPtr _obj return result -- method DBusMessage::get_signature -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_signature" g_dbus_message_get_signature :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO CString dBusMessageGetSignature :: (MonadIO m, DBusMessageK a) => a -> -- _obj m T.Text dBusMessageGetSignature _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_signature _obj' checkUnexpectedReturnNULL "g_dbus_message_get_signature" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMessage::get_unix_fd_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixFDList" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_get_unix_fd_list" g_dbus_message_get_unix_fd_list :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO (Ptr UnixFDList) dBusMessageGetUnixFdList :: (MonadIO m, DBusMessageK a) => a -> -- _obj m UnixFDList dBusMessageGetUnixFdList _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_get_unix_fd_list _obj' checkUnexpectedReturnNULL "g_dbus_message_get_unix_fd_list" result result' <- (newObject UnixFDList) result touchManagedPtr _obj return result' -- method DBusMessage::lock -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_lock" g_dbus_message_lock :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO () dBusMessageLock :: (MonadIO m, DBusMessageK a) => a -> -- _obj m () dBusMessageLock _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_message_lock _obj' touchManagedPtr _obj return () -- method DBusMessage::new_method_error_literal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_new_method_error_literal" g_dbus_message_new_method_error_literal :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CString -> -- error_name : TBasicType TUTF8 CString -> -- error_message : TBasicType TUTF8 IO (Ptr DBusMessage) dBusMessageNewMethodErrorLiteral :: (MonadIO m, DBusMessageK a) => a -> -- _obj T.Text -> -- error_name T.Text -> -- error_message m DBusMessage dBusMessageNewMethodErrorLiteral _obj error_name error_message = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj error_name' <- textToCString error_name error_message' <- textToCString error_message result <- g_dbus_message_new_method_error_literal _obj' error_name' error_message' checkUnexpectedReturnNULL "g_dbus_message_new_method_error_literal" result result' <- (wrapObject DBusMessage) result touchManagedPtr _obj freeMem error_name' freeMem error_message' return result' -- method DBusMessage::new_method_reply -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_new_method_reply" g_dbus_message_new_method_reply :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" IO (Ptr DBusMessage) dBusMessageNewMethodReply :: (MonadIO m, DBusMessageK a) => a -> -- _obj m DBusMessage dBusMessageNewMethodReply _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_new_method_reply _obj' checkUnexpectedReturnNULL "g_dbus_message_new_method_reply" result result' <- (wrapObject DBusMessage) result touchManagedPtr _obj return result' -- method DBusMessage::print -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "indent", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "indent", 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_dbus_message_print" g_dbus_message_print :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Word32 -> -- indent : TBasicType TUInt32 IO CString dBusMessagePrint :: (MonadIO m, DBusMessageK a) => a -> -- _obj Word32 -> -- indent m T.Text dBusMessagePrint _obj indent = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_message_print _obj' indent checkUnexpectedReturnNULL "g_dbus_message_print" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method DBusMessage::set_body -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "body", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "body", 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_dbus_message_set_body" g_dbus_message_set_body :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Ptr GVariant -> -- body : TVariant IO () dBusMessageSetBody :: (MonadIO m, DBusMessageK a) => a -> -- _obj GVariant -> -- body m () dBusMessageSetBody _obj body = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let body' = unsafeManagedPtrGetPtr body g_dbus_message_set_body _obj' body' touchManagedPtr _obj return () -- method DBusMessage::set_byte_order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "byte_order", argType = TInterface "Gio" "DBusMessageByteOrder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "byte_order", argType = TInterface "Gio" "DBusMessageByteOrder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_set_byte_order" g_dbus_message_set_byte_order :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CUInt -> -- byte_order : TInterface "Gio" "DBusMessageByteOrder" IO () dBusMessageSetByteOrder :: (MonadIO m, DBusMessageK a) => a -> -- _obj DBusMessageByteOrder -> -- byte_order m () dBusMessageSetByteOrder _obj byte_order = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let byte_order' = (fromIntegral . fromEnum) byte_order g_dbus_message_set_byte_order _obj' byte_order' touchManagedPtr _obj return () -- method DBusMessage::set_destination -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", 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 "Gio" "DBusMessage", 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_dbus_message_set_destination" g_dbus_message_set_destination :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CString -> -- value : TBasicType TUTF8 IO () dBusMessageSetDestination :: (MonadIO m, DBusMessageK a) => a -> -- _obj T.Text -> -- value m () dBusMessageSetDestination _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj value' <- textToCString value g_dbus_message_set_destination _obj' value' touchManagedPtr _obj freeMem value' return () -- method DBusMessage::set_error_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", 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 "Gio" "DBusMessage", 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_dbus_message_set_error_name" g_dbus_message_set_error_name :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CString -> -- value : TBasicType TUTF8 IO () dBusMessageSetErrorName :: (MonadIO m, DBusMessageK a) => a -> -- _obj T.Text -> -- value m () dBusMessageSetErrorName _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj value' <- textToCString value g_dbus_message_set_error_name _obj' value' touchManagedPtr _obj freeMem value' return () -- method DBusMessage::set_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusMessageFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusMessageFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_set_flags" g_dbus_message_set_flags :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CUInt -> -- flags : TInterface "Gio" "DBusMessageFlags" IO () dBusMessageSetFlags :: (MonadIO m, DBusMessageK a) => a -> -- _obj [DBusMessageFlags] -> -- flags m () dBusMessageSetFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags g_dbus_message_set_flags _obj' flags' touchManagedPtr _obj return () -- method DBusMessage::set_header -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "header_field", argType = TInterface "Gio" "DBusMessageHeaderField", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "header_field", argType = TInterface "Gio" "DBusMessageHeaderField", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_set_header" g_dbus_message_set_header :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CUInt -> -- header_field : TInterface "Gio" "DBusMessageHeaderField" Ptr GVariant -> -- value : TVariant IO () dBusMessageSetHeader :: (MonadIO m, DBusMessageK a) => a -> -- _obj DBusMessageHeaderField -> -- header_field Maybe (GVariant) -> -- value m () dBusMessageSetHeader _obj header_field value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let header_field' = (fromIntegral . fromEnum) header_field maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do let jValue' = unsafeManagedPtrGetPtr jValue return jValue' g_dbus_message_set_header _obj' header_field' maybeValue touchManagedPtr _obj return () -- method DBusMessage::set_interface -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", 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 "Gio" "DBusMessage", 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_dbus_message_set_interface" g_dbus_message_set_interface :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CString -> -- value : TBasicType TUTF8 IO () dBusMessageSetInterface :: (MonadIO m, DBusMessageK a) => a -> -- _obj T.Text -> -- value m () dBusMessageSetInterface _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj value' <- textToCString value g_dbus_message_set_interface _obj' value' touchManagedPtr _obj freeMem value' return () -- method DBusMessage::set_member -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", 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 "Gio" "DBusMessage", 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_dbus_message_set_member" g_dbus_message_set_member :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CString -> -- value : TBasicType TUTF8 IO () dBusMessageSetMember :: (MonadIO m, DBusMessageK a) => a -> -- _obj T.Text -> -- value m () dBusMessageSetMember _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj value' <- textToCString value g_dbus_message_set_member _obj' value' touchManagedPtr _obj freeMem value' return () -- method DBusMessage::set_message_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "DBusMessageType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "DBusMessageType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_set_message_type" g_dbus_message_set_message_type :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CUInt -> -- type : TInterface "Gio" "DBusMessageType" IO () dBusMessageSetMessageType :: (MonadIO m, DBusMessageK a) => a -> -- _obj DBusMessageType -> -- type m () dBusMessageSetMessageType _obj type_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let type_' = (fromIntegral . fromEnum) type_ g_dbus_message_set_message_type _obj' type_' touchManagedPtr _obj return () -- method DBusMessage::set_num_unix_fds -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", 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_dbus_message_set_num_unix_fds" g_dbus_message_set_num_unix_fds :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Word32 -> -- value : TBasicType TUInt32 IO () dBusMessageSetNumUnixFds :: (MonadIO m, DBusMessageK a) => a -> -- _obj Word32 -> -- value m () dBusMessageSetNumUnixFds _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_message_set_num_unix_fds _obj' value touchManagedPtr _obj return () -- method DBusMessage::set_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", 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 "Gio" "DBusMessage", 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_dbus_message_set_path" g_dbus_message_set_path :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CString -> -- value : TBasicType TUTF8 IO () dBusMessageSetPath :: (MonadIO m, DBusMessageK a) => a -> -- _obj T.Text -> -- value m () dBusMessageSetPath _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj value' <- textToCString value g_dbus_message_set_path _obj' value' touchManagedPtr _obj freeMem value' return () -- method DBusMessage::set_reply_serial -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", 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_dbus_message_set_reply_serial" g_dbus_message_set_reply_serial :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Word32 -> -- value : TBasicType TUInt32 IO () dBusMessageSetReplySerial :: (MonadIO m, DBusMessageK a) => a -> -- _obj Word32 -> -- value m () dBusMessageSetReplySerial _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_message_set_reply_serial _obj' value touchManagedPtr _obj return () -- method DBusMessage::set_sender -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", 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 "Gio" "DBusMessage", 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_dbus_message_set_sender" g_dbus_message_set_sender :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CString -> -- value : TBasicType TUTF8 IO () dBusMessageSetSender :: (MonadIO m, DBusMessageK a) => a -> -- _obj T.Text -> -- value m () dBusMessageSetSender _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj value' <- textToCString value g_dbus_message_set_sender _obj' value' touchManagedPtr _obj freeMem value' return () -- method DBusMessage::set_serial -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "serial", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "serial", 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_dbus_message_set_serial" g_dbus_message_set_serial :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Word32 -> -- serial : TBasicType TUInt32 IO () dBusMessageSetSerial :: (MonadIO m, DBusMessageK a) => a -> -- _obj Word32 -> -- serial m () dBusMessageSetSerial _obj serial = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_message_set_serial _obj' serial touchManagedPtr _obj return () -- method DBusMessage::set_signature -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", 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 "Gio" "DBusMessage", 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_dbus_message_set_signature" g_dbus_message_set_signature :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" CString -> -- value : TBasicType TUTF8 IO () dBusMessageSetSignature :: (MonadIO m, DBusMessageK a) => a -> -- _obj T.Text -> -- value m () dBusMessageSetSignature _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj value' <- textToCString value g_dbus_message_set_signature _obj' value' touchManagedPtr _obj freeMem value' return () -- method DBusMessage::set_unix_fd_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_message_set_unix_fd_list" g_dbus_message_set_unix_fd_list :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Ptr UnixFDList -> -- fd_list : TInterface "Gio" "UnixFDList" IO () dBusMessageSetUnixFdList :: (MonadIO m, DBusMessageK a, UnixFDListK b) => a -> -- _obj Maybe (b) -> -- fd_list m () dBusMessageSetUnixFdList _obj fd_list = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeFd_list <- case fd_list of Nothing -> return nullPtr Just jFd_list -> do let jFd_list' = unsafeManagedPtrCastPtr jFd_list return jFd_list' g_dbus_message_set_unix_fd_list _obj' maybeFd_list touchManagedPtr _obj whenJust fd_list touchManagedPtr return () -- method DBusMessage::to_blob -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_size", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "capabilities", argType = TInterface "Gio" "DBusCapabilityFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "out_size", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "capabilities", argType = TInterface "Gio" "DBusCapabilityFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TUInt8) -- throws : True -- Skip return : False foreign import ccall "g_dbus_message_to_blob" g_dbus_message_to_blob :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Ptr Word64 -> -- out_size : TBasicType TUInt64 CUInt -> -- capabilities : TInterface "Gio" "DBusCapabilityFlags" Ptr (Ptr GError) -> -- error IO (Ptr Word8) dBusMessageToBlob :: (MonadIO m, DBusMessageK a) => a -> -- _obj [DBusCapabilityFlags] -> -- capabilities m ByteString dBusMessageToBlob _obj capabilities = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj out_size <- allocMem :: IO (Ptr Word64) let capabilities' = gflagsToWord capabilities onException (do result <- propagateGError $ g_dbus_message_to_blob _obj' out_size capabilities' out_size' <- peek out_size checkUnexpectedReturnNULL "g_dbus_message_to_blob" result result' <- (unpackByteStringWithLength out_size') result freeMem result touchManagedPtr _obj freeMem out_size return result' ) (do freeMem out_size ) -- method DBusMessage::to_gerror -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_dbus_message_to_gerror" g_dbus_message_to_gerror :: Ptr DBusMessage -> -- _obj : TInterface "Gio" "DBusMessage" Ptr (Ptr GError) -> -- error IO CInt dBusMessageToGerror :: (MonadIO m, DBusMessageK a) => a -> -- _obj m () dBusMessageToGerror _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_dbus_message_to_gerror _obj' touchManagedPtr _obj return () ) (do return () ) -- method DBusMessage::bytes_needed -- method type : MemberFunction -- Args : [Arg {argName = "blob", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blob_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "blob_len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "blob", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_dbus_message_bytes_needed" g_dbus_message_bytes_needed :: Ptr Word8 -> -- blob : TCArray False (-1) 1 (TBasicType TUInt8) Word64 -> -- blob_len : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO Int64 dBusMessageBytesNeeded :: (MonadIO m) => ByteString -> -- blob m Int64 dBusMessageBytesNeeded blob = liftIO $ do let blob_len = fromIntegral $ B.length blob blob' <- packByteString blob onException (do result <- propagateGError $ g_dbus_message_bytes_needed blob' blob_len freeMem blob' return result ) (do freeMem blob' ) -- Enum DBusMessageByteOrder data DBusMessageByteOrder = DBusMessageByteOrderBigEndian | DBusMessageByteOrderLittleEndian | AnotherDBusMessageByteOrder Int deriving (Show, Eq) instance Enum DBusMessageByteOrder where fromEnum DBusMessageByteOrderBigEndian = 66 fromEnum DBusMessageByteOrderLittleEndian = 108 fromEnum (AnotherDBusMessageByteOrder k) = k toEnum 66 = DBusMessageByteOrderBigEndian toEnum 108 = DBusMessageByteOrderLittleEndian toEnum k = AnotherDBusMessageByteOrder k foreign import ccall "g_dbus_message_byte_order_get_type" c_g_dbus_message_byte_order_get_type :: IO GType instance BoxedEnum DBusMessageByteOrder where boxedEnumType _ = c_g_dbus_message_byte_order_get_type -- callback DBusMessageFilterFunction dBusMessageFilterFunctionClosure :: DBusMessageFilterFunction -> IO Closure dBusMessageFilterFunctionClosure cb = newCClosure =<< mkDBusMessageFilterFunction wrapped where wrapped = dBusMessageFilterFunctionWrapper Nothing cb type DBusMessageFilterFunctionC = Ptr DBusConnection -> Ptr DBusMessage -> CInt -> Ptr () -> IO (Ptr DBusMessage) foreign import ccall "wrapper" mkDBusMessageFilterFunction :: DBusMessageFilterFunctionC -> IO (FunPtr DBusMessageFilterFunctionC) type DBusMessageFilterFunction = DBusConnection -> DBusMessage -> Bool -> IO DBusMessage noDBusMessageFilterFunction :: Maybe DBusMessageFilterFunction noDBusMessageFilterFunction = Nothing dBusMessageFilterFunctionWrapper :: Maybe (Ptr (FunPtr (DBusMessageFilterFunctionC))) -> DBusMessageFilterFunction -> Ptr DBusConnection -> Ptr DBusMessage -> CInt -> Ptr () -> IO (Ptr DBusMessage) dBusMessageFilterFunctionWrapper funptrptr _cb connection message incoming _ = do connection' <- (newObject DBusConnection) connection message' <- (wrapObject DBusMessage) message let incoming' = (/= 0) incoming result <- _cb connection' message' incoming' maybeReleaseFunPtr funptrptr result' <- refObject result return result' -- Flags DBusMessageFlags data DBusMessageFlags = DBusMessageFlagsNone | DBusMessageFlagsNoReplyExpected | DBusMessageFlagsNoAutoStart | AnotherDBusMessageFlags Int deriving (Show, Eq) instance Enum DBusMessageFlags where fromEnum DBusMessageFlagsNone = 0 fromEnum DBusMessageFlagsNoReplyExpected = 1 fromEnum DBusMessageFlagsNoAutoStart = 2 fromEnum (AnotherDBusMessageFlags k) = k toEnum 0 = DBusMessageFlagsNone toEnum 1 = DBusMessageFlagsNoReplyExpected toEnum 2 = DBusMessageFlagsNoAutoStart toEnum k = AnotherDBusMessageFlags k foreign import ccall "g_dbus_message_flags_get_type" c_g_dbus_message_flags_get_type :: IO GType instance BoxedEnum DBusMessageFlags where boxedEnumType _ = c_g_dbus_message_flags_get_type instance IsGFlag DBusMessageFlags -- Enum DBusMessageHeaderField data DBusMessageHeaderField = DBusMessageHeaderFieldInvalid | DBusMessageHeaderFieldPath | DBusMessageHeaderFieldInterface | DBusMessageHeaderFieldMember | DBusMessageHeaderFieldErrorName | DBusMessageHeaderFieldReplySerial | DBusMessageHeaderFieldDestination | DBusMessageHeaderFieldSender | DBusMessageHeaderFieldSignature | DBusMessageHeaderFieldNumUnixFds | AnotherDBusMessageHeaderField Int deriving (Show, Eq) instance Enum DBusMessageHeaderField where fromEnum DBusMessageHeaderFieldInvalid = 0 fromEnum DBusMessageHeaderFieldPath = 1 fromEnum DBusMessageHeaderFieldInterface = 2 fromEnum DBusMessageHeaderFieldMember = 3 fromEnum DBusMessageHeaderFieldErrorName = 4 fromEnum DBusMessageHeaderFieldReplySerial = 5 fromEnum DBusMessageHeaderFieldDestination = 6 fromEnum DBusMessageHeaderFieldSender = 7 fromEnum DBusMessageHeaderFieldSignature = 8 fromEnum DBusMessageHeaderFieldNumUnixFds = 9 fromEnum (AnotherDBusMessageHeaderField k) = k toEnum 0 = DBusMessageHeaderFieldInvalid toEnum 1 = DBusMessageHeaderFieldPath toEnum 2 = DBusMessageHeaderFieldInterface toEnum 3 = DBusMessageHeaderFieldMember toEnum 4 = DBusMessageHeaderFieldErrorName toEnum 5 = DBusMessageHeaderFieldReplySerial toEnum 6 = DBusMessageHeaderFieldDestination toEnum 7 = DBusMessageHeaderFieldSender toEnum 8 = DBusMessageHeaderFieldSignature toEnum 9 = DBusMessageHeaderFieldNumUnixFds toEnum k = AnotherDBusMessageHeaderField k foreign import ccall "g_dbus_message_header_field_get_type" c_g_dbus_message_header_field_get_type :: IO GType instance BoxedEnum DBusMessageHeaderField where boxedEnumType _ = c_g_dbus_message_header_field_get_type -- Enum DBusMessageType data DBusMessageType = DBusMessageTypeInvalid | DBusMessageTypeMethodCall | DBusMessageTypeMethodReturn | DBusMessageTypeError | DBusMessageTypeSignal | AnotherDBusMessageType Int deriving (Show, Eq) instance Enum DBusMessageType where fromEnum DBusMessageTypeInvalid = 0 fromEnum DBusMessageTypeMethodCall = 1 fromEnum DBusMessageTypeMethodReturn = 2 fromEnum DBusMessageTypeError = 3 fromEnum DBusMessageTypeSignal = 4 fromEnum (AnotherDBusMessageType k) = k toEnum 0 = DBusMessageTypeInvalid toEnum 1 = DBusMessageTypeMethodCall toEnum 2 = DBusMessageTypeMethodReturn toEnum 3 = DBusMessageTypeError toEnum 4 = DBusMessageTypeSignal toEnum k = AnotherDBusMessageType k foreign import ccall "g_dbus_message_type_get_type" c_g_dbus_message_type_get_type :: IO GType instance BoxedEnum DBusMessageType where boxedEnumType _ = c_g_dbus_message_type_get_type -- struct DBusMethodInfo newtype DBusMethodInfo = DBusMethodInfo (ForeignPtr DBusMethodInfo) noDBusMethodInfo :: Maybe DBusMethodInfo noDBusMethodInfo = Nothing foreign import ccall "g_dbus_method_info_get_type" c_g_dbus_method_info_get_type :: IO GType instance BoxedObject DBusMethodInfo where boxedType _ = c_g_dbus_method_info_get_type dBusMethodInfoReadRefCount :: DBusMethodInfo -> IO Int32 dBusMethodInfoReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val dBusMethodInfoReadName :: DBusMethodInfo -> IO T.Text dBusMethodInfoReadName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' dBusMethodInfoReadInArgs :: DBusMethodInfo -> IO [DBusArgInfo] dBusMethodInfoReadInArgs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr (Ptr DBusArgInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusArgInfo) val' return val'' dBusMethodInfoReadOutArgs :: DBusMethodInfo -> IO [DBusArgInfo] dBusMethodInfoReadOutArgs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr (Ptr DBusArgInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusArgInfo) val' return val'' dBusMethodInfoReadAnnotations :: DBusMethodInfo -> IO [DBusAnnotationInfo] dBusMethodInfoReadAnnotations s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO (Ptr (Ptr DBusAnnotationInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusAnnotationInfo) val' return val'' -- method DBusMethodInfo::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMethodInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_info_ref" g_dbus_method_info_ref :: Ptr DBusMethodInfo -> -- _obj : TInterface "Gio" "DBusMethodInfo" IO (Ptr DBusMethodInfo) dBusMethodInfoRef :: (MonadIO m) => DBusMethodInfo -> -- _obj m DBusMethodInfo dBusMethodInfoRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_dbus_method_info_ref _obj' checkUnexpectedReturnNULL "g_dbus_method_info_ref" result result' <- (wrapBoxed DBusMethodInfo) result touchManagedPtr _obj return result' -- method DBusMethodInfo::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_info_unref" g_dbus_method_info_unref :: Ptr DBusMethodInfo -> -- _obj : TInterface "Gio" "DBusMethodInfo" IO () dBusMethodInfoUnref :: (MonadIO m) => DBusMethodInfo -> -- _obj m () dBusMethodInfoUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_method_info_unref _obj' touchManagedPtr _obj return () -- object DBusMethodInvocation newtype DBusMethodInvocation = DBusMethodInvocation (ForeignPtr DBusMethodInvocation) noDBusMethodInvocation :: Maybe DBusMethodInvocation noDBusMethodInvocation = Nothing foreign import ccall "g_dbus_method_invocation_get_type" c_g_dbus_method_invocation_get_type :: IO GType type instance ParentTypes DBusMethodInvocation = '[GObject.Object] instance GObject DBusMethodInvocation where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_method_invocation_get_type class GObject o => DBusMethodInvocationK o instance (GObject o, IsDescendantOf DBusMethodInvocation o) => DBusMethodInvocationK o toDBusMethodInvocation :: DBusMethodInvocationK o => o -> IO DBusMethodInvocation toDBusMethodInvocation = unsafeCastTo DBusMethodInvocation -- method DBusMethodInvocation::get_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_connection" g_dbus_method_invocation_get_connection :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO (Ptr DBusConnection) dBusMethodInvocationGetConnection :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m DBusConnection dBusMethodInvocationGetConnection _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_connection _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_connection" result result' <- (newObject DBusConnection) result touchManagedPtr _obj return result' -- method DBusMethodInvocation::get_interface_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_interface_name" g_dbus_method_invocation_get_interface_name :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO CString dBusMethodInvocationGetInterfaceName :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m T.Text dBusMethodInvocationGetInterfaceName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_interface_name _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_interface_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMethodInvocation::get_message -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMessage" -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_message" g_dbus_method_invocation_get_message :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO (Ptr DBusMessage) dBusMethodInvocationGetMessage :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m DBusMessage dBusMethodInvocationGetMessage _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_message _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_message" result result' <- (newObject DBusMessage) result touchManagedPtr _obj return result' -- method DBusMethodInvocation::get_method_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusMethodInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_method_info" g_dbus_method_invocation_get_method_info :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO (Ptr DBusMethodInfo) dBusMethodInvocationGetMethodInfo :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m DBusMethodInfo dBusMethodInvocationGetMethodInfo _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_method_info _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_method_info" result result' <- (newBoxed DBusMethodInfo) result touchManagedPtr _obj return result' -- method DBusMethodInvocation::get_method_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_method_name" g_dbus_method_invocation_get_method_name :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO CString dBusMethodInvocationGetMethodName :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m T.Text dBusMethodInvocationGetMethodName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_method_name _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_method_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMethodInvocation::get_object_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_object_path" g_dbus_method_invocation_get_object_path :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO CString dBusMethodInvocationGetObjectPath :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m T.Text dBusMethodInvocationGetObjectPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_object_path _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_object_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMethodInvocation::get_parameters -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_parameters" g_dbus_method_invocation_get_parameters :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO (Ptr GVariant) dBusMethodInvocationGetParameters :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m GVariant dBusMethodInvocationGetParameters _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_parameters _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_parameters" result result' <- newGVariantFromPtr result touchManagedPtr _obj return result' -- method DBusMethodInvocation::get_property_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusPropertyInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_property_info" g_dbus_method_invocation_get_property_info :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO (Ptr DBusPropertyInfo) dBusMethodInvocationGetPropertyInfo :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m DBusPropertyInfo dBusMethodInvocationGetPropertyInfo _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_property_info _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_property_info" result result' <- (newBoxed DBusPropertyInfo) result touchManagedPtr _obj return result' -- method DBusMethodInvocation::get_sender -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_get_sender" g_dbus_method_invocation_get_sender :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" IO CString dBusMethodInvocationGetSender :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj m T.Text dBusMethodInvocationGetSender _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_method_invocation_get_sender _obj' checkUnexpectedReturnNULL "g_dbus_method_invocation_get_sender" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusMethodInvocation::return_dbus_error -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error_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_dbus_method_invocation_return_dbus_error" g_dbus_method_invocation_return_dbus_error :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" CString -> -- error_name : TBasicType TUTF8 CString -> -- error_message : TBasicType TUTF8 IO () dBusMethodInvocationReturnDbusError :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj T.Text -> -- error_name T.Text -> -- error_message m () dBusMethodInvocationReturnDbusError _obj error_name error_message = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj error_name' <- textToCString error_name error_message' <- textToCString error_message g_dbus_method_invocation_return_dbus_error _obj' error_name' error_message' touchManagedPtr _obj freeMem error_name' freeMem error_message' return () -- method DBusMethodInvocation::return_error_literal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, 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 = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, 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_dbus_method_invocation_return_error_literal" g_dbus_method_invocation_return_error_literal :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" Word32 -> -- domain : TBasicType TUInt32 Int32 -> -- code : TBasicType TInt32 CString -> -- message : TBasicType TUTF8 IO () dBusMethodInvocationReturnErrorLiteral :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj Word32 -> -- domain Int32 -> -- code T.Text -> -- message m () dBusMethodInvocationReturnErrorLiteral _obj domain code message = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj message' <- textToCString message g_dbus_method_invocation_return_error_literal _obj' domain code message' touchManagedPtr _obj freeMem message' return () -- method DBusMethodInvocation::return_gerror -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", 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}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_return_gerror" g_dbus_method_invocation_return_gerror :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" Ptr GError -> -- error : TError IO () dBusMethodInvocationReturnGerror :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj GError -> -- error m () dBusMethodInvocationReturnGerror _obj error_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let error_' = unsafeManagedPtrGetPtr error_ g_dbus_method_invocation_return_gerror _obj' error_' touchManagedPtr _obj touchManagedPtr error_ return () -- method DBusMethodInvocation::return_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_return_value" g_dbus_method_invocation_return_value :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" Ptr GVariant -> -- parameters : TVariant IO () dBusMethodInvocationReturnValue :: (MonadIO m, DBusMethodInvocationK a) => a -> -- _obj Maybe (GVariant) -> -- parameters m () dBusMethodInvocationReturnValue _obj parameters = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' g_dbus_method_invocation_return_value _obj' maybeParameters touchManagedPtr _obj return () -- method DBusMethodInvocation::return_value_with_unix_fd_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusMethodInvocation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_method_invocation_return_value_with_unix_fd_list" g_dbus_method_invocation_return_value_with_unix_fd_list :: Ptr DBusMethodInvocation -> -- _obj : TInterface "Gio" "DBusMethodInvocation" Ptr GVariant -> -- parameters : TVariant Ptr UnixFDList -> -- fd_list : TInterface "Gio" "UnixFDList" IO () dBusMethodInvocationReturnValueWithUnixFdList :: (MonadIO m, DBusMethodInvocationK a, UnixFDListK b) => a -> -- _obj Maybe (GVariant) -> -- parameters Maybe (b) -> -- fd_list m () dBusMethodInvocationReturnValueWithUnixFdList _obj parameters fd_list = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' maybeFd_list <- case fd_list of Nothing -> return nullPtr Just jFd_list -> do let jFd_list' = unsafeManagedPtrCastPtr jFd_list return jFd_list' g_dbus_method_invocation_return_value_with_unix_fd_list _obj' maybeParameters maybeFd_list touchManagedPtr _obj whenJust fd_list touchManagedPtr return () -- struct DBusNodeInfo newtype DBusNodeInfo = DBusNodeInfo (ForeignPtr DBusNodeInfo) noDBusNodeInfo :: Maybe DBusNodeInfo noDBusNodeInfo = Nothing foreign import ccall "g_dbus_node_info_get_type" c_g_dbus_node_info_get_type :: IO GType instance BoxedObject DBusNodeInfo where boxedType _ = c_g_dbus_node_info_get_type dBusNodeInfoReadRefCount :: DBusNodeInfo -> IO Int32 dBusNodeInfoReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val dBusNodeInfoReadPath :: DBusNodeInfo -> IO T.Text dBusNodeInfoReadPath s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' dBusNodeInfoReadInterfaces :: DBusNodeInfo -> IO [DBusInterfaceInfo] dBusNodeInfoReadInterfaces s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr (Ptr DBusInterfaceInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusInterfaceInfo) val' return val'' dBusNodeInfoReadNodes :: DBusNodeInfo -> IO [DBusNodeInfo] dBusNodeInfoReadNodes s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr (Ptr DBusNodeInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusNodeInfo) val' return val'' dBusNodeInfoReadAnnotations :: DBusNodeInfo -> IO [DBusAnnotationInfo] dBusNodeInfoReadAnnotations s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO (Ptr (Ptr DBusAnnotationInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusAnnotationInfo) val' return val'' -- method DBusNodeInfo::new_for_xml -- method type : Constructor -- Args : [Arg {argName = "xml_data", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "xml_data", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusNodeInfo" -- throws : True -- Skip return : False foreign import ccall "g_dbus_node_info_new_for_xml" g_dbus_node_info_new_for_xml :: CString -> -- xml_data : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr DBusNodeInfo) dBusNodeInfoNewForXml :: (MonadIO m) => T.Text -> -- xml_data m DBusNodeInfo dBusNodeInfoNewForXml xml_data = liftIO $ do xml_data' <- textToCString xml_data onException (do result <- propagateGError $ g_dbus_node_info_new_for_xml xml_data' checkUnexpectedReturnNULL "g_dbus_node_info_new_for_xml" result result' <- (wrapBoxed DBusNodeInfo) result freeMem xml_data' return result' ) (do freeMem xml_data' ) -- method DBusNodeInfo::generate_xml -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusNodeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "indent", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "string_builder", argType = TInterface "GLib" "String", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusNodeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "indent", 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_dbus_node_info_generate_xml" g_dbus_node_info_generate_xml :: Ptr DBusNodeInfo -> -- _obj : TInterface "Gio" "DBusNodeInfo" Word32 -> -- indent : TBasicType TUInt32 Ptr GLib.String -> -- string_builder : TInterface "GLib" "String" IO () dBusNodeInfoGenerateXml :: (MonadIO m) => DBusNodeInfo -> -- _obj Word32 -> -- indent m (GLib.String) dBusNodeInfoGenerateXml _obj indent = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj string_builder <- callocBoxedBytes 24 :: IO (Ptr GLib.String) g_dbus_node_info_generate_xml _obj' indent string_builder string_builder' <- (wrapBoxed GLib.String) string_builder touchManagedPtr _obj return string_builder' -- method DBusNodeInfo::lookup_interface -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusNodeInfo", 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 "Gio" "DBusNodeInfo", 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 : TInterface "Gio" "DBusInterfaceInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_node_info_lookup_interface" g_dbus_node_info_lookup_interface :: Ptr DBusNodeInfo -> -- _obj : TInterface "Gio" "DBusNodeInfo" CString -> -- name : TBasicType TUTF8 IO (Ptr DBusInterfaceInfo) dBusNodeInfoLookupInterface :: (MonadIO m) => DBusNodeInfo -> -- _obj T.Text -> -- name m DBusInterfaceInfo dBusNodeInfoLookupInterface _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_dbus_node_info_lookup_interface _obj' name' checkUnexpectedReturnNULL "g_dbus_node_info_lookup_interface" result result' <- (newBoxed DBusInterfaceInfo) result touchManagedPtr _obj freeMem name' return result' -- method DBusNodeInfo::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusNodeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusNodeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusNodeInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_node_info_ref" g_dbus_node_info_ref :: Ptr DBusNodeInfo -> -- _obj : TInterface "Gio" "DBusNodeInfo" IO (Ptr DBusNodeInfo) dBusNodeInfoRef :: (MonadIO m) => DBusNodeInfo -> -- _obj m DBusNodeInfo dBusNodeInfoRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_dbus_node_info_ref _obj' checkUnexpectedReturnNULL "g_dbus_node_info_ref" result result' <- (wrapBoxed DBusNodeInfo) result touchManagedPtr _obj return result' -- method DBusNodeInfo::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusNodeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusNodeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_node_info_unref" g_dbus_node_info_unref :: Ptr DBusNodeInfo -> -- _obj : TInterface "Gio" "DBusNodeInfo" IO () dBusNodeInfoUnref :: (MonadIO m) => DBusNodeInfo -> -- _obj m () dBusNodeInfoUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_node_info_unref _obj' touchManagedPtr _obj return () -- interface DBusObject newtype DBusObject = DBusObject (ForeignPtr DBusObject) noDBusObject :: Maybe DBusObject noDBusObject = Nothing foreign import ccall "g_dbus_object_get_type" c_g_dbus_object_get_type :: IO GType type instance ParentTypes DBusObject = '[GObject.Object] instance GObject DBusObject where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_object_get_type class GObject o => DBusObjectK o instance (GObject o, IsDescendantOf DBusObject o) => DBusObjectK o toDBusObject :: DBusObjectK o => o -> IO DBusObject toDBusObject = unsafeCastTo DBusObject -- method DBusObject::get_interface -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusInterface" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_get_interface" g_dbus_object_get_interface :: Ptr DBusObject -> -- _obj : TInterface "Gio" "DBusObject" CString -> -- interface_name : TBasicType TUTF8 IO (Ptr DBusInterface) dBusObjectGetInterface :: (MonadIO m, DBusObjectK a) => a -> -- _obj T.Text -> -- interface_name m DBusInterface dBusObjectGetInterface _obj interface_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj interface_name' <- textToCString interface_name result <- g_dbus_object_get_interface _obj' interface_name' checkUnexpectedReturnNULL "g_dbus_object_get_interface" result result' <- (wrapObject DBusInterface) result touchManagedPtr _obj freeMem interface_name' return result' -- method DBusObject::get_interfaces -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "DBusInterface") -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_get_interfaces" g_dbus_object_get_interfaces :: Ptr DBusObject -> -- _obj : TInterface "Gio" "DBusObject" IO (Ptr (GList (Ptr DBusInterface))) dBusObjectGetInterfaces :: (MonadIO m, DBusObjectK a) => a -> -- _obj m [DBusInterface] dBusObjectGetInterfaces _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_get_interfaces _obj' checkUnexpectedReturnNULL "g_dbus_object_get_interfaces" result result' <- unpackGList result result'' <- mapM (wrapObject DBusInterface) result' g_list_free result touchManagedPtr _obj return result'' -- method DBusObject::get_object_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_get_object_path" g_dbus_object_get_object_path :: Ptr DBusObject -> -- _obj : TInterface "Gio" "DBusObject" IO CString dBusObjectGetObjectPath :: (MonadIO m, DBusObjectK a) => a -> -- _obj m T.Text dBusObjectGetObjectPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_get_object_path _obj' checkUnexpectedReturnNULL "g_dbus_object_get_object_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- signal DBusObject::interface-added type DBusObjectInterfaceAddedCallback = DBusInterface -> IO () noDBusObjectInterfaceAddedCallback :: Maybe DBusObjectInterfaceAddedCallback noDBusObjectInterfaceAddedCallback = Nothing type DBusObjectInterfaceAddedCallbackC = Ptr () -> -- object Ptr DBusInterface -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusObjectInterfaceAddedCallback :: DBusObjectInterfaceAddedCallbackC -> IO (FunPtr DBusObjectInterfaceAddedCallbackC) dBusObjectInterfaceAddedClosure :: DBusObjectInterfaceAddedCallback -> IO Closure dBusObjectInterfaceAddedClosure cb = newCClosure =<< mkDBusObjectInterfaceAddedCallback wrapped where wrapped = dBusObjectInterfaceAddedCallbackWrapper cb dBusObjectInterfaceAddedCallbackWrapper :: DBusObjectInterfaceAddedCallback -> Ptr () -> Ptr DBusInterface -> Ptr () -> IO () dBusObjectInterfaceAddedCallbackWrapper _cb _ interface _ = do interface' <- (newObject DBusInterface) interface _cb interface' onDBusObjectInterfaceAdded :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceAddedCallback -> m SignalHandlerId onDBusObjectInterfaceAdded obj cb = liftIO $ connectDBusObjectInterfaceAdded obj cb SignalConnectBefore afterDBusObjectInterfaceAdded :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceAddedCallback -> m SignalHandlerId afterDBusObjectInterfaceAdded obj cb = connectDBusObjectInterfaceAdded obj cb SignalConnectAfter connectDBusObjectInterfaceAdded :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceAddedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectInterfaceAdded obj cb after = liftIO $ do cb' <- mkDBusObjectInterfaceAddedCallback (dBusObjectInterfaceAddedCallbackWrapper cb) connectSignalFunPtr obj "interface-added" cb' after -- signal DBusObject::interface-removed type DBusObjectInterfaceRemovedCallback = DBusInterface -> IO () noDBusObjectInterfaceRemovedCallback :: Maybe DBusObjectInterfaceRemovedCallback noDBusObjectInterfaceRemovedCallback = Nothing type DBusObjectInterfaceRemovedCallbackC = Ptr () -> -- object Ptr DBusInterface -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusObjectInterfaceRemovedCallback :: DBusObjectInterfaceRemovedCallbackC -> IO (FunPtr DBusObjectInterfaceRemovedCallbackC) dBusObjectInterfaceRemovedClosure :: DBusObjectInterfaceRemovedCallback -> IO Closure dBusObjectInterfaceRemovedClosure cb = newCClosure =<< mkDBusObjectInterfaceRemovedCallback wrapped where wrapped = dBusObjectInterfaceRemovedCallbackWrapper cb dBusObjectInterfaceRemovedCallbackWrapper :: DBusObjectInterfaceRemovedCallback -> Ptr () -> Ptr DBusInterface -> Ptr () -> IO () dBusObjectInterfaceRemovedCallbackWrapper _cb _ interface _ = do interface' <- (newObject DBusInterface) interface _cb interface' onDBusObjectInterfaceRemoved :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceRemovedCallback -> m SignalHandlerId onDBusObjectInterfaceRemoved obj cb = liftIO $ connectDBusObjectInterfaceRemoved obj cb SignalConnectBefore afterDBusObjectInterfaceRemoved :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceRemovedCallback -> m SignalHandlerId afterDBusObjectInterfaceRemoved obj cb = connectDBusObjectInterfaceRemoved obj cb SignalConnectAfter connectDBusObjectInterfaceRemoved :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceRemovedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectInterfaceRemoved obj cb after = liftIO $ do cb' <- mkDBusObjectInterfaceRemovedCallback (dBusObjectInterfaceRemovedCallbackWrapper cb) connectSignalFunPtr obj "interface-removed" cb' after -- interface DBusObjectManager newtype DBusObjectManager = DBusObjectManager (ForeignPtr DBusObjectManager) noDBusObjectManager :: Maybe DBusObjectManager noDBusObjectManager = Nothing foreign import ccall "g_dbus_object_manager_get_type" c_g_dbus_object_manager_get_type :: IO GType type instance ParentTypes DBusObjectManager = '[GObject.Object] instance GObject DBusObjectManager where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_object_manager_get_type class GObject o => DBusObjectManagerK o instance (GObject o, IsDescendantOf DBusObjectManager o) => DBusObjectManagerK o toDBusObjectManager :: DBusObjectManagerK o => o -> IO DBusObjectManager toDBusObjectManager = unsafeCastTo DBusObjectManager -- method DBusObjectManager::get_interface -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManager", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManager", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusInterface" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_get_interface" g_dbus_object_manager_get_interface :: Ptr DBusObjectManager -> -- _obj : TInterface "Gio" "DBusObjectManager" CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 IO (Ptr DBusInterface) dBusObjectManagerGetInterface :: (MonadIO m, DBusObjectManagerK a) => a -> -- _obj T.Text -> -- object_path T.Text -> -- interface_name m DBusInterface dBusObjectManagerGetInterface _obj object_path interface_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj object_path' <- textToCString object_path interface_name' <- textToCString interface_name result <- g_dbus_object_manager_get_interface _obj' object_path' interface_name' checkUnexpectedReturnNULL "g_dbus_object_manager_get_interface" result result' <- (wrapObject DBusInterface) result touchManagedPtr _obj freeMem object_path' freeMem interface_name' return result' -- method DBusObjectManager::get_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManager", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManager", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObject" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_get_object" g_dbus_object_manager_get_object :: Ptr DBusObjectManager -> -- _obj : TInterface "Gio" "DBusObjectManager" CString -> -- object_path : TBasicType TUTF8 IO (Ptr DBusObject) dBusObjectManagerGetObject :: (MonadIO m, DBusObjectManagerK a) => a -> -- _obj T.Text -> -- object_path m DBusObject dBusObjectManagerGetObject _obj object_path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj object_path' <- textToCString object_path result <- g_dbus_object_manager_get_object _obj' object_path' checkUnexpectedReturnNULL "g_dbus_object_manager_get_object" result result' <- (wrapObject DBusObject) result touchManagedPtr _obj freeMem object_path' return result' -- method DBusObjectManager::get_object_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManager", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManager", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_get_object_path" g_dbus_object_manager_get_object_path :: Ptr DBusObjectManager -> -- _obj : TInterface "Gio" "DBusObjectManager" IO CString dBusObjectManagerGetObjectPath :: (MonadIO m, DBusObjectManagerK a) => a -> -- _obj m T.Text dBusObjectManagerGetObjectPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_manager_get_object_path _obj' checkUnexpectedReturnNULL "g_dbus_object_manager_get_object_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusObjectManager::get_objects -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManager", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManager", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "DBusObject") -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_get_objects" g_dbus_object_manager_get_objects :: Ptr DBusObjectManager -> -- _obj : TInterface "Gio" "DBusObjectManager" IO (Ptr (GList (Ptr DBusObject))) dBusObjectManagerGetObjects :: (MonadIO m, DBusObjectManagerK a) => a -> -- _obj m [DBusObject] dBusObjectManagerGetObjects _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_manager_get_objects _obj' checkUnexpectedReturnNULL "g_dbus_object_manager_get_objects" result result' <- unpackGList result result'' <- mapM (wrapObject DBusObject) result' g_list_free result touchManagedPtr _obj return result'' -- signal DBusObjectManager::interface-added type DBusObjectManagerInterfaceAddedCallback = DBusObject -> DBusInterface -> IO () noDBusObjectManagerInterfaceAddedCallback :: Maybe DBusObjectManagerInterfaceAddedCallback noDBusObjectManagerInterfaceAddedCallback = Nothing type DBusObjectManagerInterfaceAddedCallbackC = Ptr () -> -- object Ptr DBusObject -> Ptr DBusInterface -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusObjectManagerInterfaceAddedCallback :: DBusObjectManagerInterfaceAddedCallbackC -> IO (FunPtr DBusObjectManagerInterfaceAddedCallbackC) dBusObjectManagerInterfaceAddedClosure :: DBusObjectManagerInterfaceAddedCallback -> IO Closure dBusObjectManagerInterfaceAddedClosure cb = newCClosure =<< mkDBusObjectManagerInterfaceAddedCallback wrapped where wrapped = dBusObjectManagerInterfaceAddedCallbackWrapper cb dBusObjectManagerInterfaceAddedCallbackWrapper :: DBusObjectManagerInterfaceAddedCallback -> Ptr () -> Ptr DBusObject -> Ptr DBusInterface -> Ptr () -> IO () dBusObjectManagerInterfaceAddedCallbackWrapper _cb _ object interface _ = do object' <- (newObject DBusObject) object interface' <- (newObject DBusInterface) interface _cb object' interface' onDBusObjectManagerInterfaceAdded :: (GObject a, MonadIO m) => a -> DBusObjectManagerInterfaceAddedCallback -> m SignalHandlerId onDBusObjectManagerInterfaceAdded obj cb = liftIO $ connectDBusObjectManagerInterfaceAdded obj cb SignalConnectBefore afterDBusObjectManagerInterfaceAdded :: (GObject a, MonadIO m) => a -> DBusObjectManagerInterfaceAddedCallback -> m SignalHandlerId afterDBusObjectManagerInterfaceAdded obj cb = connectDBusObjectManagerInterfaceAdded obj cb SignalConnectAfter connectDBusObjectManagerInterfaceAdded :: (GObject a, MonadIO m) => a -> DBusObjectManagerInterfaceAddedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectManagerInterfaceAdded obj cb after = liftIO $ do cb' <- mkDBusObjectManagerInterfaceAddedCallback (dBusObjectManagerInterfaceAddedCallbackWrapper cb) connectSignalFunPtr obj "interface-added" cb' after -- signal DBusObjectManager::interface-removed type DBusObjectManagerInterfaceRemovedCallback = DBusObject -> DBusInterface -> IO () noDBusObjectManagerInterfaceRemovedCallback :: Maybe DBusObjectManagerInterfaceRemovedCallback noDBusObjectManagerInterfaceRemovedCallback = Nothing type DBusObjectManagerInterfaceRemovedCallbackC = Ptr () -> -- object Ptr DBusObject -> Ptr DBusInterface -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusObjectManagerInterfaceRemovedCallback :: DBusObjectManagerInterfaceRemovedCallbackC -> IO (FunPtr DBusObjectManagerInterfaceRemovedCallbackC) dBusObjectManagerInterfaceRemovedClosure :: DBusObjectManagerInterfaceRemovedCallback -> IO Closure dBusObjectManagerInterfaceRemovedClosure cb = newCClosure =<< mkDBusObjectManagerInterfaceRemovedCallback wrapped where wrapped = dBusObjectManagerInterfaceRemovedCallbackWrapper cb dBusObjectManagerInterfaceRemovedCallbackWrapper :: DBusObjectManagerInterfaceRemovedCallback -> Ptr () -> Ptr DBusObject -> Ptr DBusInterface -> Ptr () -> IO () dBusObjectManagerInterfaceRemovedCallbackWrapper _cb _ object interface _ = do object' <- (newObject DBusObject) object interface' <- (newObject DBusInterface) interface _cb object' interface' onDBusObjectManagerInterfaceRemoved :: (GObject a, MonadIO m) => a -> DBusObjectManagerInterfaceRemovedCallback -> m SignalHandlerId onDBusObjectManagerInterfaceRemoved obj cb = liftIO $ connectDBusObjectManagerInterfaceRemoved obj cb SignalConnectBefore afterDBusObjectManagerInterfaceRemoved :: (GObject a, MonadIO m) => a -> DBusObjectManagerInterfaceRemovedCallback -> m SignalHandlerId afterDBusObjectManagerInterfaceRemoved obj cb = connectDBusObjectManagerInterfaceRemoved obj cb SignalConnectAfter connectDBusObjectManagerInterfaceRemoved :: (GObject a, MonadIO m) => a -> DBusObjectManagerInterfaceRemovedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectManagerInterfaceRemoved obj cb after = liftIO $ do cb' <- mkDBusObjectManagerInterfaceRemovedCallback (dBusObjectManagerInterfaceRemovedCallbackWrapper cb) connectSignalFunPtr obj "interface-removed" cb' after -- signal DBusObjectManager::object-added type DBusObjectManagerObjectAddedCallback = DBusObject -> IO () noDBusObjectManagerObjectAddedCallback :: Maybe DBusObjectManagerObjectAddedCallback noDBusObjectManagerObjectAddedCallback = Nothing type DBusObjectManagerObjectAddedCallbackC = Ptr () -> -- object Ptr DBusObject -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusObjectManagerObjectAddedCallback :: DBusObjectManagerObjectAddedCallbackC -> IO (FunPtr DBusObjectManagerObjectAddedCallbackC) dBusObjectManagerObjectAddedClosure :: DBusObjectManagerObjectAddedCallback -> IO Closure dBusObjectManagerObjectAddedClosure cb = newCClosure =<< mkDBusObjectManagerObjectAddedCallback wrapped where wrapped = dBusObjectManagerObjectAddedCallbackWrapper cb dBusObjectManagerObjectAddedCallbackWrapper :: DBusObjectManagerObjectAddedCallback -> Ptr () -> Ptr DBusObject -> Ptr () -> IO () dBusObjectManagerObjectAddedCallbackWrapper _cb _ object _ = do object' <- (newObject DBusObject) object _cb object' onDBusObjectManagerObjectAdded :: (GObject a, MonadIO m) => a -> DBusObjectManagerObjectAddedCallback -> m SignalHandlerId onDBusObjectManagerObjectAdded obj cb = liftIO $ connectDBusObjectManagerObjectAdded obj cb SignalConnectBefore afterDBusObjectManagerObjectAdded :: (GObject a, MonadIO m) => a -> DBusObjectManagerObjectAddedCallback -> m SignalHandlerId afterDBusObjectManagerObjectAdded obj cb = connectDBusObjectManagerObjectAdded obj cb SignalConnectAfter connectDBusObjectManagerObjectAdded :: (GObject a, MonadIO m) => a -> DBusObjectManagerObjectAddedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectManagerObjectAdded obj cb after = liftIO $ do cb' <- mkDBusObjectManagerObjectAddedCallback (dBusObjectManagerObjectAddedCallbackWrapper cb) connectSignalFunPtr obj "object-added" cb' after -- signal DBusObjectManager::object-removed type DBusObjectManagerObjectRemovedCallback = DBusObject -> IO () noDBusObjectManagerObjectRemovedCallback :: Maybe DBusObjectManagerObjectRemovedCallback noDBusObjectManagerObjectRemovedCallback = Nothing type DBusObjectManagerObjectRemovedCallbackC = Ptr () -> -- object Ptr DBusObject -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusObjectManagerObjectRemovedCallback :: DBusObjectManagerObjectRemovedCallbackC -> IO (FunPtr DBusObjectManagerObjectRemovedCallbackC) dBusObjectManagerObjectRemovedClosure :: DBusObjectManagerObjectRemovedCallback -> IO Closure dBusObjectManagerObjectRemovedClosure cb = newCClosure =<< mkDBusObjectManagerObjectRemovedCallback wrapped where wrapped = dBusObjectManagerObjectRemovedCallbackWrapper cb dBusObjectManagerObjectRemovedCallbackWrapper :: DBusObjectManagerObjectRemovedCallback -> Ptr () -> Ptr DBusObject -> Ptr () -> IO () dBusObjectManagerObjectRemovedCallbackWrapper _cb _ object _ = do object' <- (newObject DBusObject) object _cb object' onDBusObjectManagerObjectRemoved :: (GObject a, MonadIO m) => a -> DBusObjectManagerObjectRemovedCallback -> m SignalHandlerId onDBusObjectManagerObjectRemoved obj cb = liftIO $ connectDBusObjectManagerObjectRemoved obj cb SignalConnectBefore afterDBusObjectManagerObjectRemoved :: (GObject a, MonadIO m) => a -> DBusObjectManagerObjectRemovedCallback -> m SignalHandlerId afterDBusObjectManagerObjectRemoved obj cb = connectDBusObjectManagerObjectRemoved obj cb SignalConnectAfter connectDBusObjectManagerObjectRemoved :: (GObject a, MonadIO m) => a -> DBusObjectManagerObjectRemovedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectManagerObjectRemoved obj cb after = liftIO $ do cb' <- mkDBusObjectManagerObjectRemovedCallback (dBusObjectManagerObjectRemovedCallbackWrapper cb) connectSignalFunPtr obj "object-removed" cb' after -- object DBusObjectManagerClient newtype DBusObjectManagerClient = DBusObjectManagerClient (ForeignPtr DBusObjectManagerClient) noDBusObjectManagerClient :: Maybe DBusObjectManagerClient noDBusObjectManagerClient = Nothing foreign import ccall "g_dbus_object_manager_client_get_type" c_g_dbus_object_manager_client_get_type :: IO GType type instance ParentTypes DBusObjectManagerClient = '[GObject.Object, AsyncInitable, DBusObjectManager, Initable] instance GObject DBusObjectManagerClient where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_object_manager_client_get_type class GObject o => DBusObjectManagerClientK o instance (GObject o, IsDescendantOf DBusObjectManagerClient o) => DBusObjectManagerClientK o toDBusObjectManagerClient :: DBusObjectManagerClientK o => o -> IO DBusObjectManagerClient toDBusObjectManagerClient = unsafeCastTo DBusObjectManagerClient -- method DBusObjectManagerClient::new_finish -- method type : Constructor -- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObjectManagerClient" -- throws : True -- Skip return : False foreign import ccall "g_dbus_object_manager_client_new_finish" g_dbus_object_manager_client_new_finish :: Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr DBusObjectManagerClient) dBusObjectManagerClientNewFinish :: (MonadIO m, AsyncResultK a) => a -> -- res m DBusObjectManagerClient dBusObjectManagerClientNewFinish res = liftIO $ do let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_object_manager_client_new_finish res' checkUnexpectedReturnNULL "g_dbus_object_manager_client_new_finish" result result' <- (wrapObject DBusObjectManagerClient) result touchManagedPtr res return result' ) (do return () ) -- method DBusObjectManagerClient::new_for_bus_finish -- method type : Constructor -- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObjectManagerClient" -- throws : True -- Skip return : False foreign import ccall "g_dbus_object_manager_client_new_for_bus_finish" g_dbus_object_manager_client_new_for_bus_finish :: Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr DBusObjectManagerClient) dBusObjectManagerClientNewForBusFinish :: (MonadIO m, AsyncResultK a) => a -> -- res m DBusObjectManagerClient dBusObjectManagerClientNewForBusFinish res = liftIO $ do let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_object_manager_client_new_for_bus_finish res' checkUnexpectedReturnNULL "g_dbus_object_manager_client_new_for_bus_finish" result result' <- (wrapObject DBusObjectManagerClient) result touchManagedPtr res return result' ) (do return () ) -- method DBusObjectManagerClient::new_for_bus_sync -- method type : Constructor -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "get_proxy_type_user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObjectManagerClient" -- throws : True -- Skip return : False foreign import ccall "g_dbus_object_manager_client_new_for_bus_sync" g_dbus_object_manager_client_new_for_bus_sync :: CUInt -> -- bus_type : TInterface "Gio" "BusType" CUInt -> -- flags : TInterface "Gio" "DBusObjectManagerClientFlags" CString -> -- name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 FunPtr DBusProxyTypeFuncC -> -- get_proxy_type_func : TInterface "Gio" "DBusProxyTypeFunc" Ptr () -> -- get_proxy_type_user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- get_proxy_type_destroy_notify : TInterface "GLib" "DestroyNotify" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusObjectManagerClient) dBusObjectManagerClientNewForBusSync :: (MonadIO m, CancellableK a) => BusType -> -- bus_type [DBusObjectManagerClientFlags] -> -- flags T.Text -> -- name T.Text -> -- object_path Maybe (DBusProxyTypeFunc) -> -- get_proxy_type_func Maybe (a) -> -- cancellable m DBusObjectManagerClient dBusObjectManagerClientNewForBusSync bus_type flags name object_path get_proxy_type_func_ cancellable = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type let flags' = gflagsToWord flags name' <- textToCString name object_path' <- textToCString object_path maybeGet_proxy_type_func_ <- case get_proxy_type_func_ of Nothing -> return (castPtrToFunPtr nullPtr) Just jGet_proxy_type_func_ -> do jGet_proxy_type_func_' <- mkDBusProxyTypeFunc (dBusProxyTypeFuncWrapper Nothing jGet_proxy_type_func_) return jGet_proxy_type_func_' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' let get_proxy_type_user_data_ = castFunPtrToPtr maybeGet_proxy_type_func_ let get_proxy_type_destroy_notify_ = safeFreeFunPtrPtr onException (do result <- propagateGError $ g_dbus_object_manager_client_new_for_bus_sync bus_type' flags' name' object_path' maybeGet_proxy_type_func_ get_proxy_type_user_data_ get_proxy_type_destroy_notify_ maybeCancellable checkUnexpectedReturnNULL "g_dbus_object_manager_client_new_for_bus_sync" result result' <- (wrapObject DBusObjectManagerClient) result whenJust cancellable touchManagedPtr freeMem name' freeMem object_path' return result' ) (do freeMem name' freeMem object_path' ) -- method DBusObjectManagerClient::new_sync -- method type : Constructor -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "get_proxy_type_user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObjectManagerClient" -- throws : True -- Skip return : False foreign import ccall "g_dbus_object_manager_client_new_sync" g_dbus_object_manager_client_new_sync :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CUInt -> -- flags : TInterface "Gio" "DBusObjectManagerClientFlags" CString -> -- name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 FunPtr DBusProxyTypeFuncC -> -- get_proxy_type_func : TInterface "Gio" "DBusProxyTypeFunc" Ptr () -> -- get_proxy_type_user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- get_proxy_type_destroy_notify : TInterface "GLib" "DestroyNotify" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusObjectManagerClient) dBusObjectManagerClientNewSync :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- connection [DBusObjectManagerClientFlags] -> -- flags Maybe (T.Text) -> -- name T.Text -> -- object_path Maybe (DBusProxyTypeFunc) -> -- get_proxy_type_func Maybe (b) -> -- cancellable m DBusObjectManagerClient dBusObjectManagerClientNewSync connection flags name object_path get_proxy_type_func_ cancellable = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection let flags' = gflagsToWord flags maybeName <- case name of Nothing -> return nullPtr Just jName -> do jName' <- textToCString jName return jName' object_path' <- textToCString object_path maybeGet_proxy_type_func_ <- case get_proxy_type_func_ of Nothing -> return (castPtrToFunPtr nullPtr) Just jGet_proxy_type_func_ -> do jGet_proxy_type_func_' <- mkDBusProxyTypeFunc (dBusProxyTypeFuncWrapper Nothing jGet_proxy_type_func_) return jGet_proxy_type_func_' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' let get_proxy_type_user_data_ = castFunPtrToPtr maybeGet_proxy_type_func_ let get_proxy_type_destroy_notify_ = safeFreeFunPtrPtr onException (do result <- propagateGError $ g_dbus_object_manager_client_new_sync connection' flags' maybeName object_path' maybeGet_proxy_type_func_ get_proxy_type_user_data_ get_proxy_type_destroy_notify_ maybeCancellable checkUnexpectedReturnNULL "g_dbus_object_manager_client_new_sync" result result' <- (wrapObject DBusObjectManagerClient) result touchManagedPtr connection whenJust cancellable touchManagedPtr freeMem maybeName freeMem object_path' return result' ) (do freeMem maybeName freeMem object_path' ) -- method DBusObjectManagerClient::get_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_client_get_connection" g_dbus_object_manager_client_get_connection :: Ptr DBusObjectManagerClient -> -- _obj : TInterface "Gio" "DBusObjectManagerClient" IO (Ptr DBusConnection) dBusObjectManagerClientGetConnection :: (MonadIO m, DBusObjectManagerClientK a) => a -> -- _obj m DBusConnection dBusObjectManagerClientGetConnection _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_manager_client_get_connection _obj' checkUnexpectedReturnNULL "g_dbus_object_manager_client_get_connection" result result' <- (newObject DBusConnection) result touchManagedPtr _obj return result' -- method DBusObjectManagerClient::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObjectManagerClientFlags" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_client_get_flags" g_dbus_object_manager_client_get_flags :: Ptr DBusObjectManagerClient -> -- _obj : TInterface "Gio" "DBusObjectManagerClient" IO CUInt dBusObjectManagerClientGetFlags :: (MonadIO m, DBusObjectManagerClientK a) => a -> -- _obj m [DBusObjectManagerClientFlags] dBusObjectManagerClientGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_manager_client_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method DBusObjectManagerClient::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_client_get_name" g_dbus_object_manager_client_get_name :: Ptr DBusObjectManagerClient -> -- _obj : TInterface "Gio" "DBusObjectManagerClient" IO CString dBusObjectManagerClientGetName :: (MonadIO m, DBusObjectManagerClientK a) => a -> -- _obj m T.Text dBusObjectManagerClientGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_manager_client_get_name _obj' checkUnexpectedReturnNULL "g_dbus_object_manager_client_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusObjectManagerClient::get_name_owner -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_client_get_name_owner" g_dbus_object_manager_client_get_name_owner :: Ptr DBusObjectManagerClient -> -- _obj : TInterface "Gio" "DBusObjectManagerClient" IO CString dBusObjectManagerClientGetNameOwner :: (MonadIO m, DBusObjectManagerClientK a) => a -> -- _obj m T.Text dBusObjectManagerClientGetNameOwner _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_manager_client_get_name_owner _obj' checkUnexpectedReturnNULL "g_dbus_object_manager_client_get_name_owner" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method DBusObjectManagerClient::new -- method type : MemberFunction -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "get_proxy_type_user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 9, 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 = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 9, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_client_new" g_dbus_object_manager_client_new :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CUInt -> -- flags : TInterface "Gio" "DBusObjectManagerClientFlags" CString -> -- name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 FunPtr DBusProxyTypeFuncC -> -- get_proxy_type_func : TInterface "Gio" "DBusProxyTypeFunc" Ptr () -> -- get_proxy_type_user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- get_proxy_type_destroy_notify : TInterface "GLib" "DestroyNotify" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusObjectManagerClientNew :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- connection [DBusObjectManagerClientFlags] -> -- flags T.Text -> -- name T.Text -> -- object_path Maybe (DBusProxyTypeFunc) -> -- get_proxy_type_func Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusObjectManagerClientNew connection flags name object_path get_proxy_type_func_ cancellable callback = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection let flags' = gflagsToWord flags name' <- textToCString name object_path' <- textToCString object_path maybeGet_proxy_type_func_ <- case get_proxy_type_func_ of Nothing -> return (castPtrToFunPtr nullPtr) Just jGet_proxy_type_func_ -> do jGet_proxy_type_func_' <- mkDBusProxyTypeFunc (dBusProxyTypeFuncWrapper Nothing jGet_proxy_type_func_) return jGet_proxy_type_func_' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let get_proxy_type_user_data_ = castFunPtrToPtr maybeGet_proxy_type_func_ let get_proxy_type_destroy_notify_ = safeFreeFunPtrPtr let user_data = nullPtr g_dbus_object_manager_client_new connection' flags' name' object_path' maybeGet_proxy_type_func_ get_proxy_type_user_data_ get_proxy_type_destroy_notify_ maybeCancellable maybeCallback user_data touchManagedPtr connection whenJust cancellable touchManagedPtr freeMem name' freeMem object_path' return () -- method DBusObjectManagerClient::new_for_bus -- method type : MemberFunction -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "get_proxy_type_user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 9, 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 = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 9, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_client_new_for_bus" g_dbus_object_manager_client_new_for_bus :: CUInt -> -- bus_type : TInterface "Gio" "BusType" CUInt -> -- flags : TInterface "Gio" "DBusObjectManagerClientFlags" CString -> -- name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 FunPtr DBusProxyTypeFuncC -> -- get_proxy_type_func : TInterface "Gio" "DBusProxyTypeFunc" Ptr () -> -- get_proxy_type_user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- get_proxy_type_destroy_notify : TInterface "GLib" "DestroyNotify" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusObjectManagerClientNewForBus :: (MonadIO m, CancellableK a) => BusType -> -- bus_type [DBusObjectManagerClientFlags] -> -- flags T.Text -> -- name T.Text -> -- object_path Maybe (DBusProxyTypeFunc) -> -- get_proxy_type_func Maybe (a) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusObjectManagerClientNewForBus bus_type flags name object_path get_proxy_type_func_ cancellable callback = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type let flags' = gflagsToWord flags name' <- textToCString name object_path' <- textToCString object_path maybeGet_proxy_type_func_ <- case get_proxy_type_func_ of Nothing -> return (castPtrToFunPtr nullPtr) Just jGet_proxy_type_func_ -> do jGet_proxy_type_func_' <- mkDBusProxyTypeFunc (dBusProxyTypeFuncWrapper Nothing jGet_proxy_type_func_) return jGet_proxy_type_func_' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let get_proxy_type_user_data_ = castFunPtrToPtr maybeGet_proxy_type_func_ let get_proxy_type_destroy_notify_ = safeFreeFunPtrPtr let user_data = nullPtr g_dbus_object_manager_client_new_for_bus bus_type' flags' name' object_path' maybeGet_proxy_type_func_ get_proxy_type_user_data_ get_proxy_type_destroy_notify_ maybeCancellable maybeCallback user_data whenJust cancellable touchManagedPtr freeMem name' freeMem object_path' return () -- signal DBusObjectManagerClient::interface-proxy-properties-changed type DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback = DBusObjectProxy -> DBusProxy -> GVariant -> [T.Text] -> IO () noDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback :: Maybe DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback noDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback = Nothing type DBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackC = Ptr () -> -- object Ptr DBusObjectProxy -> Ptr DBusProxy -> Ptr GVariant -> Ptr CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback :: DBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackC -> IO (FunPtr DBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackC) dBusObjectManagerClientInterfaceProxyPropertiesChangedClosure :: DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> IO Closure dBusObjectManagerClientInterfaceProxyPropertiesChangedClosure cb = newCClosure =<< mkDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback wrapped where wrapped = dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper cb dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper :: DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> Ptr () -> Ptr DBusObjectProxy -> Ptr DBusProxy -> Ptr GVariant -> Ptr CString -> Ptr () -> IO () dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper _cb _ object_proxy interface_proxy changed_properties invalidated_properties _ = do object_proxy' <- (newObject DBusObjectProxy) object_proxy interface_proxy' <- (newObject DBusProxy) interface_proxy changed_properties' <- newGVariantFromPtr changed_properties invalidated_properties' <- unpackZeroTerminatedUTF8CArray invalidated_properties _cb object_proxy' interface_proxy' changed_properties' invalidated_properties' onDBusObjectManagerClientInterfaceProxyPropertiesChanged :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> m SignalHandlerId onDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb = liftIO $ connectDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb SignalConnectBefore afterDBusObjectManagerClientInterfaceProxyPropertiesChanged :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> m SignalHandlerId afterDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb = connectDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb SignalConnectAfter connectDBusObjectManagerClientInterfaceProxyPropertiesChanged :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb after = liftIO $ do cb' <- mkDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback (dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper cb) connectSignalFunPtr obj "interface-proxy-properties-changed" cb' after -- signal DBusObjectManagerClient::interface-proxy-signal type DBusObjectManagerClientInterfaceProxySignalCallback = DBusObjectProxy -> DBusProxy -> T.Text -> T.Text -> GVariant -> IO () noDBusObjectManagerClientInterfaceProxySignalCallback :: Maybe DBusObjectManagerClientInterfaceProxySignalCallback noDBusObjectManagerClientInterfaceProxySignalCallback = Nothing type DBusObjectManagerClientInterfaceProxySignalCallbackC = Ptr () -> -- object Ptr DBusObjectProxy -> Ptr DBusProxy -> CString -> CString -> Ptr GVariant -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusObjectManagerClientInterfaceProxySignalCallback :: DBusObjectManagerClientInterfaceProxySignalCallbackC -> IO (FunPtr DBusObjectManagerClientInterfaceProxySignalCallbackC) dBusObjectManagerClientInterfaceProxySignalClosure :: DBusObjectManagerClientInterfaceProxySignalCallback -> IO Closure dBusObjectManagerClientInterfaceProxySignalClosure cb = newCClosure =<< mkDBusObjectManagerClientInterfaceProxySignalCallback wrapped where wrapped = dBusObjectManagerClientInterfaceProxySignalCallbackWrapper cb dBusObjectManagerClientInterfaceProxySignalCallbackWrapper :: DBusObjectManagerClientInterfaceProxySignalCallback -> Ptr () -> Ptr DBusObjectProxy -> Ptr DBusProxy -> CString -> CString -> Ptr GVariant -> Ptr () -> IO () dBusObjectManagerClientInterfaceProxySignalCallbackWrapper _cb _ object_proxy interface_proxy sender_name signal_name parameters _ = do object_proxy' <- (newObject DBusObjectProxy) object_proxy interface_proxy' <- (newObject DBusProxy) interface_proxy sender_name' <- cstringToText sender_name signal_name' <- cstringToText signal_name parameters' <- newGVariantFromPtr parameters _cb object_proxy' interface_proxy' sender_name' signal_name' parameters' onDBusObjectManagerClientInterfaceProxySignal :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxySignalCallback -> m SignalHandlerId onDBusObjectManagerClientInterfaceProxySignal obj cb = liftIO $ connectDBusObjectManagerClientInterfaceProxySignal obj cb SignalConnectBefore afterDBusObjectManagerClientInterfaceProxySignal :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxySignalCallback -> m SignalHandlerId afterDBusObjectManagerClientInterfaceProxySignal obj cb = connectDBusObjectManagerClientInterfaceProxySignal obj cb SignalConnectAfter connectDBusObjectManagerClientInterfaceProxySignal :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxySignalCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectManagerClientInterfaceProxySignal obj cb after = liftIO $ do cb' <- mkDBusObjectManagerClientInterfaceProxySignalCallback (dBusObjectManagerClientInterfaceProxySignalCallbackWrapper cb) connectSignalFunPtr obj "interface-proxy-signal" cb' after -- Flags DBusObjectManagerClientFlags data DBusObjectManagerClientFlags = DBusObjectManagerClientFlagsNone | DBusObjectManagerClientFlagsDoNotAutoStart | AnotherDBusObjectManagerClientFlags Int deriving (Show, Eq) instance Enum DBusObjectManagerClientFlags where fromEnum DBusObjectManagerClientFlagsNone = 0 fromEnum DBusObjectManagerClientFlagsDoNotAutoStart = 1 fromEnum (AnotherDBusObjectManagerClientFlags k) = k toEnum 0 = DBusObjectManagerClientFlagsNone toEnum 1 = DBusObjectManagerClientFlagsDoNotAutoStart toEnum k = AnotherDBusObjectManagerClientFlags k foreign import ccall "g_dbus_object_manager_client_flags_get_type" c_g_dbus_object_manager_client_flags_get_type :: IO GType instance BoxedEnum DBusObjectManagerClientFlags where boxedEnumType _ = c_g_dbus_object_manager_client_flags_get_type instance IsGFlag DBusObjectManagerClientFlags -- object DBusObjectManagerServer newtype DBusObjectManagerServer = DBusObjectManagerServer (ForeignPtr DBusObjectManagerServer) noDBusObjectManagerServer :: Maybe DBusObjectManagerServer noDBusObjectManagerServer = Nothing foreign import ccall "g_dbus_object_manager_server_get_type" c_g_dbus_object_manager_server_get_type :: IO GType type instance ParentTypes DBusObjectManagerServer = '[GObject.Object, DBusObjectManager] instance GObject DBusObjectManagerServer where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_object_manager_server_get_type class GObject o => DBusObjectManagerServerK o instance (GObject o, IsDescendantOf DBusObjectManagerServer o) => DBusObjectManagerServerK o toDBusObjectManagerServer :: DBusObjectManagerServerK o => o -> IO DBusObjectManagerServer toDBusObjectManagerServer = unsafeCastTo DBusObjectManagerServer -- method DBusObjectManagerServer::new -- method type : Constructor -- Args : [Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObjectManagerServer" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_server_new" g_dbus_object_manager_server_new :: CString -> -- object_path : TBasicType TUTF8 IO (Ptr DBusObjectManagerServer) dBusObjectManagerServerNew :: (MonadIO m) => T.Text -> -- object_path m DBusObjectManagerServer dBusObjectManagerServerNew object_path = liftIO $ do object_path' <- textToCString object_path result <- g_dbus_object_manager_server_new object_path' checkUnexpectedReturnNULL "g_dbus_object_manager_server_new" result result' <- (wrapObject DBusObjectManagerServer) result freeMem object_path' return result' -- method DBusObjectManagerServer::export -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_server_export" g_dbus_object_manager_server_export :: Ptr DBusObjectManagerServer -> -- _obj : TInterface "Gio" "DBusObjectManagerServer" Ptr DBusObjectSkeleton -> -- object : TInterface "Gio" "DBusObjectSkeleton" IO () dBusObjectManagerServerExport :: (MonadIO m, DBusObjectManagerServerK a, DBusObjectSkeletonK b) => a -> -- _obj b -> -- object m () dBusObjectManagerServerExport _obj object = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let object' = unsafeManagedPtrCastPtr object g_dbus_object_manager_server_export _obj' object' touchManagedPtr _obj touchManagedPtr object return () -- method DBusObjectManagerServer::export_uniquely -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_server_export_uniquely" g_dbus_object_manager_server_export_uniquely :: Ptr DBusObjectManagerServer -> -- _obj : TInterface "Gio" "DBusObjectManagerServer" Ptr DBusObjectSkeleton -> -- object : TInterface "Gio" "DBusObjectSkeleton" IO () dBusObjectManagerServerExportUniquely :: (MonadIO m, DBusObjectManagerServerK a, DBusObjectSkeletonK b) => a -> -- _obj b -> -- object m () dBusObjectManagerServerExportUniquely _obj object = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let object' = unsafeManagedPtrCastPtr object g_dbus_object_manager_server_export_uniquely _obj' object' touchManagedPtr _obj touchManagedPtr object return () -- method DBusObjectManagerServer::get_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_server_get_connection" g_dbus_object_manager_server_get_connection :: Ptr DBusObjectManagerServer -> -- _obj : TInterface "Gio" "DBusObjectManagerServer" IO (Ptr DBusConnection) dBusObjectManagerServerGetConnection :: (MonadIO m, DBusObjectManagerServerK a) => a -> -- _obj m DBusConnection dBusObjectManagerServerGetConnection _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_manager_server_get_connection _obj' checkUnexpectedReturnNULL "g_dbus_object_manager_server_get_connection" result result' <- (wrapObject DBusConnection) result touchManagedPtr _obj return result' -- method DBusObjectManagerServer::is_exported -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_server_is_exported" g_dbus_object_manager_server_is_exported :: Ptr DBusObjectManagerServer -> -- _obj : TInterface "Gio" "DBusObjectManagerServer" Ptr DBusObjectSkeleton -> -- object : TInterface "Gio" "DBusObjectSkeleton" IO CInt dBusObjectManagerServerIsExported :: (MonadIO m, DBusObjectManagerServerK a, DBusObjectSkeletonK b) => a -> -- _obj b -> -- object m Bool dBusObjectManagerServerIsExported _obj object = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let object' = unsafeManagedPtrCastPtr object result <- g_dbus_object_manager_server_is_exported _obj' object' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr object return result' -- method DBusObjectManagerServer::set_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_manager_server_set_connection" g_dbus_object_manager_server_set_connection :: Ptr DBusObjectManagerServer -> -- _obj : TInterface "Gio" "DBusObjectManagerServer" Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" IO () dBusObjectManagerServerSetConnection :: (MonadIO m, DBusObjectManagerServerK a, DBusConnectionK b) => a -> -- _obj Maybe (b) -> -- connection m () dBusObjectManagerServerSetConnection _obj connection = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeConnection <- case connection of Nothing -> return nullPtr Just jConnection -> do let jConnection' = unsafeManagedPtrCastPtr jConnection return jConnection' g_dbus_object_manager_server_set_connection _obj' maybeConnection touchManagedPtr _obj whenJust connection touchManagedPtr return () -- method DBusObjectManagerServer::unexport -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", 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_dbus_object_manager_server_unexport" g_dbus_object_manager_server_unexport :: Ptr DBusObjectManagerServer -> -- _obj : TInterface "Gio" "DBusObjectManagerServer" CString -> -- object_path : TBasicType TUTF8 IO CInt dBusObjectManagerServerUnexport :: (MonadIO m, DBusObjectManagerServerK a) => a -> -- _obj T.Text -> -- object_path m Bool dBusObjectManagerServerUnexport _obj object_path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj object_path' <- textToCString object_path result <- g_dbus_object_manager_server_unexport _obj' object_path' let result' = (/= 0) result touchManagedPtr _obj freeMem object_path' return result' -- object DBusObjectProxy newtype DBusObjectProxy = DBusObjectProxy (ForeignPtr DBusObjectProxy) noDBusObjectProxy :: Maybe DBusObjectProxy noDBusObjectProxy = Nothing foreign import ccall "g_dbus_object_proxy_get_type" c_g_dbus_object_proxy_get_type :: IO GType type instance ParentTypes DBusObjectProxy = '[GObject.Object, DBusObject] instance GObject DBusObjectProxy where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_object_proxy_get_type class GObject o => DBusObjectProxyK o instance (GObject o, IsDescendantOf DBusObjectProxy o) => DBusObjectProxyK o toDBusObjectProxy :: DBusObjectProxyK o => o -> IO DBusObjectProxy toDBusObjectProxy = unsafeCastTo DBusObjectProxy -- method DBusObjectProxy::new -- method type : Constructor -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObjectProxy" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_proxy_new" g_dbus_object_proxy_new :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CString -> -- object_path : TBasicType TUTF8 IO (Ptr DBusObjectProxy) dBusObjectProxyNew :: (MonadIO m, DBusConnectionK a) => a -> -- connection T.Text -> -- object_path m DBusObjectProxy dBusObjectProxyNew connection object_path = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection object_path' <- textToCString object_path result <- g_dbus_object_proxy_new connection' object_path' checkUnexpectedReturnNULL "g_dbus_object_proxy_new" result result' <- (wrapObject DBusObjectProxy) result touchManagedPtr connection freeMem object_path' return result' -- method DBusObjectProxy::get_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_proxy_get_connection" g_dbus_object_proxy_get_connection :: Ptr DBusObjectProxy -> -- _obj : TInterface "Gio" "DBusObjectProxy" IO (Ptr DBusConnection) dBusObjectProxyGetConnection :: (MonadIO m, DBusObjectProxyK a) => a -> -- _obj m DBusConnection dBusObjectProxyGetConnection _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_object_proxy_get_connection _obj' checkUnexpectedReturnNULL "g_dbus_object_proxy_get_connection" result result' <- (newObject DBusConnection) result touchManagedPtr _obj return result' -- object DBusObjectSkeleton newtype DBusObjectSkeleton = DBusObjectSkeleton (ForeignPtr DBusObjectSkeleton) noDBusObjectSkeleton :: Maybe DBusObjectSkeleton noDBusObjectSkeleton = Nothing foreign import ccall "g_dbus_object_skeleton_get_type" c_g_dbus_object_skeleton_get_type :: IO GType type instance ParentTypes DBusObjectSkeleton = '[GObject.Object, DBusObject] instance GObject DBusObjectSkeleton where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_object_skeleton_get_type class GObject o => DBusObjectSkeletonK o instance (GObject o, IsDescendantOf DBusObjectSkeleton o) => DBusObjectSkeletonK o toDBusObjectSkeleton :: DBusObjectSkeletonK o => o -> IO DBusObjectSkeleton toDBusObjectSkeleton = unsafeCastTo DBusObjectSkeleton -- method DBusObjectSkeleton::new -- method type : Constructor -- Args : [Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusObjectSkeleton" -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_skeleton_new" g_dbus_object_skeleton_new :: CString -> -- object_path : TBasicType TUTF8 IO (Ptr DBusObjectSkeleton) dBusObjectSkeletonNew :: (MonadIO m) => T.Text -> -- object_path m DBusObjectSkeleton dBusObjectSkeletonNew object_path = liftIO $ do object_path' <- textToCString object_path result <- g_dbus_object_skeleton_new object_path' checkUnexpectedReturnNULL "g_dbus_object_skeleton_new" result result' <- (wrapObject DBusObjectSkeleton) result freeMem object_path' return result' -- method DBusObjectSkeleton::add_interface -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_skeleton_add_interface" g_dbus_object_skeleton_add_interface :: Ptr DBusObjectSkeleton -> -- _obj : TInterface "Gio" "DBusObjectSkeleton" Ptr DBusInterfaceSkeleton -> -- interface_ : TInterface "Gio" "DBusInterfaceSkeleton" IO () dBusObjectSkeletonAddInterface :: (MonadIO m, DBusObjectSkeletonK a, DBusInterfaceSkeletonK b) => a -> -- _obj b -> -- interface_ m () dBusObjectSkeletonAddInterface _obj interface_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let interface_' = unsafeManagedPtrCastPtr interface_ g_dbus_object_skeleton_add_interface _obj' interface_' touchManagedPtr _obj touchManagedPtr interface_ return () -- method DBusObjectSkeleton::flush -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_skeleton_flush" g_dbus_object_skeleton_flush :: Ptr DBusObjectSkeleton -> -- _obj : TInterface "Gio" "DBusObjectSkeleton" IO () dBusObjectSkeletonFlush :: (MonadIO m, DBusObjectSkeletonK a) => a -> -- _obj m () dBusObjectSkeletonFlush _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_object_skeleton_flush _obj' touchManagedPtr _obj return () -- method DBusObjectSkeleton::remove_interface -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_", argType = TInterface "Gio" "DBusInterfaceSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_object_skeleton_remove_interface" g_dbus_object_skeleton_remove_interface :: Ptr DBusObjectSkeleton -> -- _obj : TInterface "Gio" "DBusObjectSkeleton" Ptr DBusInterfaceSkeleton -> -- interface_ : TInterface "Gio" "DBusInterfaceSkeleton" IO () dBusObjectSkeletonRemoveInterface :: (MonadIO m, DBusObjectSkeletonK a, DBusInterfaceSkeletonK b) => a -> -- _obj b -> -- interface_ m () dBusObjectSkeletonRemoveInterface _obj interface_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let interface_' = unsafeManagedPtrCastPtr interface_ g_dbus_object_skeleton_remove_interface _obj' interface_' touchManagedPtr _obj touchManagedPtr interface_ return () -- method DBusObjectSkeleton::remove_interface_by_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_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_dbus_object_skeleton_remove_interface_by_name" g_dbus_object_skeleton_remove_interface_by_name :: Ptr DBusObjectSkeleton -> -- _obj : TInterface "Gio" "DBusObjectSkeleton" CString -> -- interface_name : TBasicType TUTF8 IO () dBusObjectSkeletonRemoveInterfaceByName :: (MonadIO m, DBusObjectSkeletonK a) => a -> -- _obj T.Text -> -- interface_name m () dBusObjectSkeletonRemoveInterfaceByName _obj interface_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj interface_name' <- textToCString interface_name g_dbus_object_skeleton_remove_interface_by_name _obj' interface_name' touchManagedPtr _obj freeMem interface_name' return () -- method DBusObjectSkeleton::set_object_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectSkeleton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", 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_dbus_object_skeleton_set_object_path" g_dbus_object_skeleton_set_object_path :: Ptr DBusObjectSkeleton -> -- _obj : TInterface "Gio" "DBusObjectSkeleton" CString -> -- object_path : TBasicType TUTF8 IO () dBusObjectSkeletonSetObjectPath :: (MonadIO m, DBusObjectSkeletonK a) => a -> -- _obj T.Text -> -- object_path m () dBusObjectSkeletonSetObjectPath _obj object_path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj object_path' <- textToCString object_path g_dbus_object_skeleton_set_object_path _obj' object_path' touchManagedPtr _obj freeMem object_path' return () -- signal DBusObjectSkeleton::authorize-method type DBusObjectSkeletonAuthorizeMethodCallback = DBusInterfaceSkeleton -> DBusMethodInvocation -> IO Bool noDBusObjectSkeletonAuthorizeMethodCallback :: Maybe DBusObjectSkeletonAuthorizeMethodCallback noDBusObjectSkeletonAuthorizeMethodCallback = Nothing type DBusObjectSkeletonAuthorizeMethodCallbackC = Ptr () -> -- object Ptr DBusInterfaceSkeleton -> Ptr DBusMethodInvocation -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkDBusObjectSkeletonAuthorizeMethodCallback :: DBusObjectSkeletonAuthorizeMethodCallbackC -> IO (FunPtr DBusObjectSkeletonAuthorizeMethodCallbackC) dBusObjectSkeletonAuthorizeMethodClosure :: DBusObjectSkeletonAuthorizeMethodCallback -> IO Closure dBusObjectSkeletonAuthorizeMethodClosure cb = newCClosure =<< mkDBusObjectSkeletonAuthorizeMethodCallback wrapped where wrapped = dBusObjectSkeletonAuthorizeMethodCallbackWrapper cb dBusObjectSkeletonAuthorizeMethodCallbackWrapper :: DBusObjectSkeletonAuthorizeMethodCallback -> Ptr () -> Ptr DBusInterfaceSkeleton -> Ptr DBusMethodInvocation -> Ptr () -> IO CInt dBusObjectSkeletonAuthorizeMethodCallbackWrapper _cb _ interface invocation _ = do interface' <- (newObject DBusInterfaceSkeleton) interface invocation' <- (newObject DBusMethodInvocation) invocation result <- _cb interface' invocation' let result' = (fromIntegral . fromEnum) result return result' onDBusObjectSkeletonAuthorizeMethod :: (GObject a, MonadIO m) => a -> DBusObjectSkeletonAuthorizeMethodCallback -> m SignalHandlerId onDBusObjectSkeletonAuthorizeMethod obj cb = liftIO $ connectDBusObjectSkeletonAuthorizeMethod obj cb SignalConnectBefore afterDBusObjectSkeletonAuthorizeMethod :: (GObject a, MonadIO m) => a -> DBusObjectSkeletonAuthorizeMethodCallback -> m SignalHandlerId afterDBusObjectSkeletonAuthorizeMethod obj cb = connectDBusObjectSkeletonAuthorizeMethod obj cb SignalConnectAfter connectDBusObjectSkeletonAuthorizeMethod :: (GObject a, MonadIO m) => a -> DBusObjectSkeletonAuthorizeMethodCallback -> SignalConnectMode -> m SignalHandlerId connectDBusObjectSkeletonAuthorizeMethod obj cb after = liftIO $ do cb' <- mkDBusObjectSkeletonAuthorizeMethodCallback (dBusObjectSkeletonAuthorizeMethodCallbackWrapper cb) connectSignalFunPtr obj "authorize-method" cb' after -- struct DBusPropertyInfo newtype DBusPropertyInfo = DBusPropertyInfo (ForeignPtr DBusPropertyInfo) noDBusPropertyInfo :: Maybe DBusPropertyInfo noDBusPropertyInfo = Nothing foreign import ccall "g_dbus_property_info_get_type" c_g_dbus_property_info_get_type :: IO GType instance BoxedObject DBusPropertyInfo where boxedType _ = c_g_dbus_property_info_get_type dBusPropertyInfoReadRefCount :: DBusPropertyInfo -> IO Int32 dBusPropertyInfoReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val dBusPropertyInfoReadName :: DBusPropertyInfo -> IO T.Text dBusPropertyInfoReadName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' dBusPropertyInfoReadSignature :: DBusPropertyInfo -> IO T.Text dBusPropertyInfoReadSignature s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' dBusPropertyInfoReadFlags :: DBusPropertyInfo -> IO [DBusPropertyInfoFlags] dBusPropertyInfoReadFlags s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO CUInt let val' = wordToGFlags val return val' dBusPropertyInfoReadAnnotations :: DBusPropertyInfo -> IO [DBusAnnotationInfo] dBusPropertyInfoReadAnnotations s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO (Ptr (Ptr DBusAnnotationInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusAnnotationInfo) val' return val'' -- method DBusPropertyInfo::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusPropertyInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusPropertyInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusPropertyInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_property_info_ref" g_dbus_property_info_ref :: Ptr DBusPropertyInfo -> -- _obj : TInterface "Gio" "DBusPropertyInfo" IO (Ptr DBusPropertyInfo) dBusPropertyInfoRef :: (MonadIO m) => DBusPropertyInfo -> -- _obj m DBusPropertyInfo dBusPropertyInfoRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_dbus_property_info_ref _obj' checkUnexpectedReturnNULL "g_dbus_property_info_ref" result result' <- (wrapBoxed DBusPropertyInfo) result touchManagedPtr _obj return result' -- method DBusPropertyInfo::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusPropertyInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusPropertyInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_property_info_unref" g_dbus_property_info_unref :: Ptr DBusPropertyInfo -> -- _obj : TInterface "Gio" "DBusPropertyInfo" IO () dBusPropertyInfoUnref :: (MonadIO m) => DBusPropertyInfo -> -- _obj m () dBusPropertyInfoUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_property_info_unref _obj' touchManagedPtr _obj return () -- Flags DBusPropertyInfoFlags data DBusPropertyInfoFlags = DBusPropertyInfoFlagsNone | DBusPropertyInfoFlagsReadable | DBusPropertyInfoFlagsWritable | AnotherDBusPropertyInfoFlags Int deriving (Show, Eq) instance Enum DBusPropertyInfoFlags where fromEnum DBusPropertyInfoFlagsNone = 0 fromEnum DBusPropertyInfoFlagsReadable = 1 fromEnum DBusPropertyInfoFlagsWritable = 2 fromEnum (AnotherDBusPropertyInfoFlags k) = k toEnum 0 = DBusPropertyInfoFlagsNone toEnum 1 = DBusPropertyInfoFlagsReadable toEnum 2 = DBusPropertyInfoFlagsWritable toEnum k = AnotherDBusPropertyInfoFlags k foreign import ccall "g_dbus_property_info_flags_get_type" c_g_dbus_property_info_flags_get_type :: IO GType instance BoxedEnum DBusPropertyInfoFlags where boxedEnumType _ = c_g_dbus_property_info_flags_get_type instance IsGFlag DBusPropertyInfoFlags -- object DBusProxy newtype DBusProxy = DBusProxy (ForeignPtr DBusProxy) noDBusProxy :: Maybe DBusProxy noDBusProxy = Nothing foreign import ccall "g_dbus_proxy_get_type" c_g_dbus_proxy_get_type :: IO GType type instance ParentTypes DBusProxy = '[GObject.Object, AsyncInitable, DBusInterface, Initable] instance GObject DBusProxy where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_proxy_get_type class GObject o => DBusProxyK o instance (GObject o, IsDescendantOf DBusProxy o) => DBusProxyK o toDBusProxy :: DBusProxyK o => o -> IO DBusProxy toDBusProxy = unsafeCastTo DBusProxy -- method DBusProxy::new_finish -- method type : Constructor -- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusProxy" -- throws : True -- Skip return : False foreign import ccall "g_dbus_proxy_new_finish" g_dbus_proxy_new_finish :: Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr DBusProxy) dBusProxyNewFinish :: (MonadIO m, AsyncResultK a) => a -> -- res m DBusProxy dBusProxyNewFinish res = liftIO $ do let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_proxy_new_finish res' checkUnexpectedReturnNULL "g_dbus_proxy_new_finish" result result' <- (wrapObject DBusProxy) result touchManagedPtr res return result' ) (do return () ) -- method DBusProxy::new_for_bus_finish -- method type : Constructor -- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusProxy" -- throws : True -- Skip return : False foreign import ccall "g_dbus_proxy_new_for_bus_finish" g_dbus_proxy_new_for_bus_finish :: Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr DBusProxy) dBusProxyNewForBusFinish :: (MonadIO m, AsyncResultK a) => a -> -- res m DBusProxy dBusProxyNewForBusFinish res = liftIO $ do let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_proxy_new_for_bus_finish res' checkUnexpectedReturnNULL "g_dbus_proxy_new_for_bus_finish" result result' <- (wrapObject DBusProxy) result touchManagedPtr res return result' ) (do return () ) -- method DBusProxy::new_for_bus_sync -- method type : Constructor -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusProxyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusProxyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusProxy" -- throws : True -- Skip return : False foreign import ccall "g_dbus_proxy_new_for_bus_sync" g_dbus_proxy_new_for_bus_sync :: CUInt -> -- bus_type : TInterface "Gio" "BusType" CUInt -> -- flags : TInterface "Gio" "DBusProxyFlags" Ptr DBusInterfaceInfo -> -- info : TInterface "Gio" "DBusInterfaceInfo" CString -> -- name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusProxy) dBusProxyNewForBusSync :: (MonadIO m, CancellableK a) => BusType -> -- bus_type [DBusProxyFlags] -> -- flags Maybe (DBusInterfaceInfo) -> -- info T.Text -> -- name T.Text -> -- object_path T.Text -> -- interface_name Maybe (a) -> -- cancellable m DBusProxy dBusProxyNewForBusSync bus_type flags info name object_path interface_name cancellable = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type let flags' = gflagsToWord flags maybeInfo <- case info of Nothing -> return nullPtr Just jInfo -> do let jInfo' = unsafeManagedPtrGetPtr jInfo return jInfo' name' <- textToCString name object_path' <- textToCString object_path interface_name' <- textToCString interface_name maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_proxy_new_for_bus_sync bus_type' flags' maybeInfo name' object_path' interface_name' maybeCancellable checkUnexpectedReturnNULL "g_dbus_proxy_new_for_bus_sync" result result' <- (wrapObject DBusProxy) result whenJust info touchManagedPtr whenJust cancellable touchManagedPtr freeMem name' freeMem object_path' freeMem interface_name' return result' ) (do freeMem name' freeMem object_path' freeMem interface_name' ) -- method DBusProxy::new_sync -- method type : Constructor -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusProxyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusProxyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusProxy" -- throws : True -- Skip return : False foreign import ccall "g_dbus_proxy_new_sync" g_dbus_proxy_new_sync :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CUInt -> -- flags : TInterface "Gio" "DBusProxyFlags" Ptr DBusInterfaceInfo -> -- info : TInterface "Gio" "DBusInterfaceInfo" CString -> -- name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusProxy) dBusProxyNewSync :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- connection [DBusProxyFlags] -> -- flags Maybe (DBusInterfaceInfo) -> -- info Maybe (T.Text) -> -- name T.Text -> -- object_path T.Text -> -- interface_name Maybe (b) -> -- cancellable m DBusProxy dBusProxyNewSync connection flags info name object_path interface_name cancellable = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection let flags' = gflagsToWord flags maybeInfo <- case info of Nothing -> return nullPtr Just jInfo -> do let jInfo' = unsafeManagedPtrGetPtr jInfo return jInfo' maybeName <- case name of Nothing -> return nullPtr Just jName -> do jName' <- textToCString jName return jName' object_path' <- textToCString object_path interface_name' <- textToCString interface_name maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_proxy_new_sync connection' flags' maybeInfo maybeName object_path' interface_name' maybeCancellable checkUnexpectedReturnNULL "g_dbus_proxy_new_sync" result result' <- (wrapObject DBusProxy) result touchManagedPtr connection whenJust info touchManagedPtr whenJust cancellable touchManagedPtr freeMem maybeName freeMem object_path' freeMem interface_name' return result' ) (do freeMem maybeName freeMem object_path' freeMem interface_name' ) -- method DBusProxy::call -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, 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 "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_call" g_dbus_proxy_call :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" CString -> -- method_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant CUInt -> -- flags : TInterface "Gio" "DBusCallFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusProxyCall :: (MonadIO m, DBusProxyK a, CancellableK b) => a -> -- _obj T.Text -> -- method_name Maybe (GVariant) -> -- parameters [DBusCallFlags] -> -- flags Int32 -> -- timeout_msec Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusProxyCall _obj method_name parameters flags timeout_msec cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj method_name' <- textToCString method_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_proxy_call _obj' method_name' maybeParameters flags' timeout_msec maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem method_name' return () -- method DBusProxy::call_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_dbus_proxy_call_finish" g_dbus_proxy_call_finish :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr GVariant) dBusProxyCallFinish :: (MonadIO m, DBusProxyK a, AsyncResultK b) => a -> -- _obj b -> -- res m GVariant dBusProxyCallFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_proxy_call_finish _obj' res' checkUnexpectedReturnNULL "g_dbus_proxy_call_finish" result result' <- wrapGVariantPtr result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method DBusProxy::call_sync -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_dbus_proxy_call_sync" g_dbus_proxy_call_sync :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" CString -> -- method_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant CUInt -> -- flags : TInterface "Gio" "DBusCallFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr GVariant) dBusProxyCallSync :: (MonadIO m, DBusProxyK a, CancellableK b) => a -> -- _obj T.Text -> -- method_name Maybe (GVariant) -> -- parameters [DBusCallFlags] -> -- flags Int32 -> -- timeout_msec Maybe (b) -> -- cancellable m GVariant dBusProxyCallSync _obj method_name parameters flags timeout_msec cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj method_name' <- textToCString method_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_proxy_call_sync _obj' method_name' maybeParameters flags' timeout_msec maybeCancellable checkUnexpectedReturnNULL "g_dbus_proxy_call_sync" result result' <- wrapGVariantPtr result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem method_name' return result' ) (do freeMem method_name' ) -- method DBusProxy::call_with_unix_fd_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, 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 "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_call_with_unix_fd_list" g_dbus_proxy_call_with_unix_fd_list :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" CString -> -- method_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant CUInt -> -- flags : TInterface "Gio" "DBusCallFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr UnixFDList -> -- fd_list : TInterface "Gio" "UnixFDList" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusProxyCallWithUnixFdList :: (MonadIO m, DBusProxyK a, UnixFDListK b, CancellableK c) => a -> -- _obj T.Text -> -- method_name Maybe (GVariant) -> -- parameters [DBusCallFlags] -> -- flags Int32 -> -- timeout_msec Maybe (b) -> -- fd_list Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusProxyCallWithUnixFdList _obj method_name parameters flags timeout_msec fd_list cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj method_name' <- textToCString method_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' let flags' = gflagsToWord flags maybeFd_list <- case fd_list of Nothing -> return nullPtr Just jFd_list -> do let jFd_list' = unsafeManagedPtrCastPtr jFd_list return jFd_list' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_proxy_call_with_unix_fd_list _obj' method_name' maybeParameters flags' timeout_msec maybeFd_list maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust fd_list touchManagedPtr whenJust cancellable touchManagedPtr freeMem method_name' return () -- method DBusProxy::call_with_unix_fd_list_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_dbus_proxy_call_with_unix_fd_list_finish" g_dbus_proxy_call_with_unix_fd_list_finish :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" Ptr (Ptr UnixFDList) -> -- out_fd_list : TInterface "Gio" "UnixFDList" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr GVariant) dBusProxyCallWithUnixFdListFinish :: (MonadIO m, DBusProxyK a, AsyncResultK b) => a -> -- _obj b -> -- res m (GVariant,UnixFDList) dBusProxyCallWithUnixFdListFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj out_fd_list <- allocMem :: IO (Ptr (Ptr UnixFDList)) let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_dbus_proxy_call_with_unix_fd_list_finish _obj' out_fd_list res' checkUnexpectedReturnNULL "g_dbus_proxy_call_with_unix_fd_list_finish" result result' <- wrapGVariantPtr result out_fd_list' <- peek out_fd_list out_fd_list'' <- (wrapObject UnixFDList) out_fd_list' touchManagedPtr _obj touchManagedPtr res freeMem out_fd_list return (result', out_fd_list'') ) (do freeMem out_fd_list ) -- method DBusProxy::call_with_unix_fd_list_sync -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "method_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusCallFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : True -- Skip return : False foreign import ccall "g_dbus_proxy_call_with_unix_fd_list_sync" g_dbus_proxy_call_with_unix_fd_list_sync :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" CString -> -- method_name : TBasicType TUTF8 Ptr GVariant -> -- parameters : TVariant CUInt -> -- flags : TInterface "Gio" "DBusCallFlags" Int32 -> -- timeout_msec : TBasicType TInt32 Ptr UnixFDList -> -- fd_list : TInterface "Gio" "UnixFDList" Ptr (Ptr UnixFDList) -> -- out_fd_list : TInterface "Gio" "UnixFDList" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr GVariant) dBusProxyCallWithUnixFdListSync :: (MonadIO m, DBusProxyK a, UnixFDListK b, CancellableK c) => a -> -- _obj T.Text -> -- method_name Maybe (GVariant) -> -- parameters [DBusCallFlags] -> -- flags Int32 -> -- timeout_msec Maybe (b) -> -- fd_list Maybe (c) -> -- cancellable m (GVariant,UnixFDList) dBusProxyCallWithUnixFdListSync _obj method_name parameters flags timeout_msec fd_list cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj method_name' <- textToCString method_name maybeParameters <- case parameters of Nothing -> return nullPtr Just jParameters -> do let jParameters' = unsafeManagedPtrGetPtr jParameters return jParameters' let flags' = gflagsToWord flags maybeFd_list <- case fd_list of Nothing -> return nullPtr Just jFd_list -> do let jFd_list' = unsafeManagedPtrCastPtr jFd_list return jFd_list' out_fd_list <- allocMem :: IO (Ptr (Ptr UnixFDList)) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_proxy_call_with_unix_fd_list_sync _obj' method_name' maybeParameters flags' timeout_msec maybeFd_list out_fd_list maybeCancellable checkUnexpectedReturnNULL "g_dbus_proxy_call_with_unix_fd_list_sync" result result' <- wrapGVariantPtr result out_fd_list' <- peek out_fd_list out_fd_list'' <- (wrapObject UnixFDList) out_fd_list' touchManagedPtr _obj whenJust fd_list touchManagedPtr whenJust cancellable touchManagedPtr freeMem method_name' freeMem out_fd_list return (result', out_fd_list'') ) (do freeMem method_name' freeMem out_fd_list ) -- method DBusProxy::get_cached_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_cached_property" g_dbus_proxy_get_cached_property :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" CString -> -- property_name : TBasicType TUTF8 IO (Ptr GVariant) dBusProxyGetCachedProperty :: (MonadIO m, DBusProxyK a) => a -> -- _obj T.Text -> -- property_name m GVariant dBusProxyGetCachedProperty _obj property_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj property_name' <- textToCString property_name result <- g_dbus_proxy_get_cached_property _obj' property_name' checkUnexpectedReturnNULL "g_dbus_proxy_get_cached_property" result result' <- wrapGVariantPtr result touchManagedPtr _obj freeMem property_name' return result' -- method DBusProxy::get_cached_property_names -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", 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_dbus_proxy_get_cached_property_names" g_dbus_proxy_get_cached_property_names :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO (Ptr CString) dBusProxyGetCachedPropertyNames :: (MonadIO m, DBusProxyK a) => a -> -- _obj m [T.Text] dBusProxyGetCachedPropertyNames _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_cached_property_names _obj' checkUnexpectedReturnNULL "g_dbus_proxy_get_cached_property_names" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method DBusProxy::get_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_connection" g_dbus_proxy_get_connection :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO (Ptr DBusConnection) dBusProxyGetConnection :: (MonadIO m, DBusProxyK a) => a -> -- _obj m DBusConnection dBusProxyGetConnection _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_connection _obj' checkUnexpectedReturnNULL "g_dbus_proxy_get_connection" result result' <- (newObject DBusConnection) result touchManagedPtr _obj return result' -- method DBusProxy::get_default_timeout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_default_timeout" g_dbus_proxy_get_default_timeout :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO Int32 dBusProxyGetDefaultTimeout :: (MonadIO m, DBusProxyK a) => a -> -- _obj m Int32 dBusProxyGetDefaultTimeout _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_default_timeout _obj' touchManagedPtr _obj return result -- method DBusProxy::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusProxyFlags" -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_flags" g_dbus_proxy_get_flags :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO CUInt dBusProxyGetFlags :: (MonadIO m, DBusProxyK a) => a -> -- _obj m [DBusProxyFlags] dBusProxyGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method DBusProxy::get_interface_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusInterfaceInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_interface_info" g_dbus_proxy_get_interface_info :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO (Ptr DBusInterfaceInfo) dBusProxyGetInterfaceInfo :: (MonadIO m, DBusProxyK a) => a -> -- _obj m DBusInterfaceInfo dBusProxyGetInterfaceInfo _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_interface_info _obj' checkUnexpectedReturnNULL "g_dbus_proxy_get_interface_info" result result' <- (wrapBoxed DBusInterfaceInfo) result touchManagedPtr _obj return result' -- method DBusProxy::get_interface_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_interface_name" g_dbus_proxy_get_interface_name :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO CString dBusProxyGetInterfaceName :: (MonadIO m, DBusProxyK a) => a -> -- _obj m T.Text dBusProxyGetInterfaceName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_interface_name _obj' checkUnexpectedReturnNULL "g_dbus_proxy_get_interface_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusProxy::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_name" g_dbus_proxy_get_name :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO CString dBusProxyGetName :: (MonadIO m, DBusProxyK a) => a -> -- _obj m T.Text dBusProxyGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_name _obj' checkUnexpectedReturnNULL "g_dbus_proxy_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusProxy::get_name_owner -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_name_owner" g_dbus_proxy_get_name_owner :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO CString dBusProxyGetNameOwner :: (MonadIO m, DBusProxyK a) => a -> -- _obj m T.Text dBusProxyGetNameOwner _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_name_owner _obj' checkUnexpectedReturnNULL "g_dbus_proxy_get_name_owner" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method DBusProxy::get_object_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_get_object_path" g_dbus_proxy_get_object_path :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" IO CString dBusProxyGetObjectPath :: (MonadIO m, DBusProxyK a) => a -> -- _obj m T.Text dBusProxyGetObjectPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_proxy_get_object_path _obj' checkUnexpectedReturnNULL "g_dbus_proxy_get_object_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusProxy::set_cached_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_set_cached_property" g_dbus_proxy_set_cached_property :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" CString -> -- property_name : TBasicType TUTF8 Ptr GVariant -> -- value : TVariant IO () dBusProxySetCachedProperty :: (MonadIO m, DBusProxyK a) => a -> -- _obj T.Text -> -- property_name Maybe (GVariant) -> -- value m () dBusProxySetCachedProperty _obj property_name value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj property_name' <- textToCString property_name maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do let jValue' = unsafeManagedPtrGetPtr jValue return jValue' g_dbus_proxy_set_cached_property _obj' property_name' maybeValue touchManagedPtr _obj freeMem property_name' return () -- method DBusProxy::set_default_timeout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout_msec", 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_dbus_proxy_set_default_timeout" g_dbus_proxy_set_default_timeout :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" Int32 -> -- timeout_msec : TBasicType TInt32 IO () dBusProxySetDefaultTimeout :: (MonadIO m, DBusProxyK a) => a -> -- _obj Int32 -> -- timeout_msec m () dBusProxySetDefaultTimeout _obj timeout_msec = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_proxy_set_default_timeout _obj' timeout_msec touchManagedPtr _obj return () -- method DBusProxy::set_interface_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusProxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_set_interface_info" g_dbus_proxy_set_interface_info :: Ptr DBusProxy -> -- _obj : TInterface "Gio" "DBusProxy" Ptr DBusInterfaceInfo -> -- info : TInterface "Gio" "DBusInterfaceInfo" IO () dBusProxySetInterfaceInfo :: (MonadIO m, DBusProxyK a) => a -> -- _obj Maybe (DBusInterfaceInfo) -> -- info m () dBusProxySetInterfaceInfo _obj info = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeInfo <- case info of Nothing -> return nullPtr Just jInfo -> do let jInfo' = unsafeManagedPtrGetPtr jInfo return jInfo' g_dbus_proxy_set_interface_info _obj' maybeInfo touchManagedPtr _obj whenJust info touchManagedPtr return () -- method DBusProxy::new -- method type : MemberFunction -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusProxyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, 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 = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusProxyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_new" g_dbus_proxy_new :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CUInt -> -- flags : TInterface "Gio" "DBusProxyFlags" Ptr DBusInterfaceInfo -> -- info : TInterface "Gio" "DBusInterfaceInfo" CString -> -- name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusProxyNew :: (MonadIO m, DBusConnectionK a, CancellableK b) => a -> -- connection [DBusProxyFlags] -> -- flags Maybe (DBusInterfaceInfo) -> -- info Maybe (T.Text) -> -- name T.Text -> -- object_path T.Text -> -- interface_name Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusProxyNew connection flags info name object_path interface_name cancellable callback = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection let flags' = gflagsToWord flags maybeInfo <- case info of Nothing -> return nullPtr Just jInfo -> do let jInfo' = unsafeManagedPtrGetPtr jInfo return jInfo' maybeName <- case name of Nothing -> return nullPtr Just jName -> do jName' <- textToCString jName return jName' object_path' <- textToCString object_path interface_name' <- textToCString interface_name maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_proxy_new connection' flags' maybeInfo maybeName object_path' interface_name' maybeCancellable maybeCallback user_data touchManagedPtr connection whenJust info touchManagedPtr whenJust cancellable touchManagedPtr freeMem maybeName freeMem object_path' freeMem interface_name' return () -- method DBusProxy::new_for_bus -- method type : MemberFunction -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusProxyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, 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 = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusProxyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "DBusInterfaceInfo", direction = DirectionIn, mayBeNull = True, 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 = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_proxy_new_for_bus" g_dbus_proxy_new_for_bus :: CUInt -> -- bus_type : TInterface "Gio" "BusType" CUInt -> -- flags : TInterface "Gio" "DBusProxyFlags" Ptr DBusInterfaceInfo -> -- info : TInterface "Gio" "DBusInterfaceInfo" CString -> -- name : TBasicType TUTF8 CString -> -- object_path : TBasicType TUTF8 CString -> -- interface_name : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dBusProxyNewForBus :: (MonadIO m, CancellableK a) => BusType -> -- bus_type [DBusProxyFlags] -> -- flags Maybe (DBusInterfaceInfo) -> -- info T.Text -> -- name T.Text -> -- object_path T.Text -> -- interface_name Maybe (a) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dBusProxyNewForBus bus_type flags info name object_path interface_name cancellable callback = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type let flags' = gflagsToWord flags maybeInfo <- case info of Nothing -> return nullPtr Just jInfo -> do let jInfo' = unsafeManagedPtrGetPtr jInfo return jInfo' name' <- textToCString name object_path' <- textToCString object_path interface_name' <- textToCString interface_name maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_proxy_new_for_bus bus_type' flags' maybeInfo name' object_path' interface_name' maybeCancellable maybeCallback user_data whenJust info touchManagedPtr whenJust cancellable touchManagedPtr freeMem name' freeMem object_path' freeMem interface_name' return () -- signal DBusProxy::g-properties-changed type DBusProxyGPropertiesChangedCallback = GVariant -> [T.Text] -> IO () noDBusProxyGPropertiesChangedCallback :: Maybe DBusProxyGPropertiesChangedCallback noDBusProxyGPropertiesChangedCallback = Nothing type DBusProxyGPropertiesChangedCallbackC = Ptr () -> -- object Ptr GVariant -> Ptr CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusProxyGPropertiesChangedCallback :: DBusProxyGPropertiesChangedCallbackC -> IO (FunPtr DBusProxyGPropertiesChangedCallbackC) dBusProxyGPropertiesChangedClosure :: DBusProxyGPropertiesChangedCallback -> IO Closure dBusProxyGPropertiesChangedClosure cb = newCClosure =<< mkDBusProxyGPropertiesChangedCallback wrapped where wrapped = dBusProxyGPropertiesChangedCallbackWrapper cb dBusProxyGPropertiesChangedCallbackWrapper :: DBusProxyGPropertiesChangedCallback -> Ptr () -> Ptr GVariant -> Ptr CString -> Ptr () -> IO () dBusProxyGPropertiesChangedCallbackWrapper _cb _ changed_properties invalidated_properties _ = do changed_properties' <- newGVariantFromPtr changed_properties invalidated_properties' <- unpackZeroTerminatedUTF8CArray invalidated_properties _cb changed_properties' invalidated_properties' onDBusProxyGPropertiesChanged :: (GObject a, MonadIO m) => a -> DBusProxyGPropertiesChangedCallback -> m SignalHandlerId onDBusProxyGPropertiesChanged obj cb = liftIO $ connectDBusProxyGPropertiesChanged obj cb SignalConnectBefore afterDBusProxyGPropertiesChanged :: (GObject a, MonadIO m) => a -> DBusProxyGPropertiesChangedCallback -> m SignalHandlerId afterDBusProxyGPropertiesChanged obj cb = connectDBusProxyGPropertiesChanged obj cb SignalConnectAfter connectDBusProxyGPropertiesChanged :: (GObject a, MonadIO m) => a -> DBusProxyGPropertiesChangedCallback -> SignalConnectMode -> m SignalHandlerId connectDBusProxyGPropertiesChanged obj cb after = liftIO $ do cb' <- mkDBusProxyGPropertiesChangedCallback (dBusProxyGPropertiesChangedCallbackWrapper cb) connectSignalFunPtr obj "g-properties-changed" cb' after -- signal DBusProxy::g-signal type DBusProxyGSignalCallback = Maybe T.Text -> T.Text -> GVariant -> IO () noDBusProxyGSignalCallback :: Maybe DBusProxyGSignalCallback noDBusProxyGSignalCallback = Nothing type DBusProxyGSignalCallbackC = Ptr () -> -- object CString -> CString -> Ptr GVariant -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDBusProxyGSignalCallback :: DBusProxyGSignalCallbackC -> IO (FunPtr DBusProxyGSignalCallbackC) dBusProxyGSignalClosure :: DBusProxyGSignalCallback -> IO Closure dBusProxyGSignalClosure cb = newCClosure =<< mkDBusProxyGSignalCallback wrapped where wrapped = dBusProxyGSignalCallbackWrapper cb dBusProxyGSignalCallbackWrapper :: DBusProxyGSignalCallback -> Ptr () -> CString -> CString -> Ptr GVariant -> Ptr () -> IO () dBusProxyGSignalCallbackWrapper _cb _ sender_name signal_name parameters _ = do maybeSender_name <- if sender_name == nullPtr then return Nothing else do sender_name' <- cstringToText sender_name return $ Just sender_name' signal_name' <- cstringToText signal_name parameters' <- newGVariantFromPtr parameters _cb maybeSender_name signal_name' parameters' onDBusProxyGSignal :: (GObject a, MonadIO m) => a -> DBusProxyGSignalCallback -> m SignalHandlerId onDBusProxyGSignal obj cb = liftIO $ connectDBusProxyGSignal obj cb SignalConnectBefore afterDBusProxyGSignal :: (GObject a, MonadIO m) => a -> DBusProxyGSignalCallback -> m SignalHandlerId afterDBusProxyGSignal obj cb = connectDBusProxyGSignal obj cb SignalConnectAfter connectDBusProxyGSignal :: (GObject a, MonadIO m) => a -> DBusProxyGSignalCallback -> SignalConnectMode -> m SignalHandlerId connectDBusProxyGSignal obj cb after = liftIO $ do cb' <- mkDBusProxyGSignalCallback (dBusProxyGSignalCallbackWrapper cb) connectSignalFunPtr obj "g-signal" cb' after -- Flags DBusProxyFlags data DBusProxyFlags = DBusProxyFlagsNone | DBusProxyFlagsDoNotLoadProperties | DBusProxyFlagsDoNotConnectSignals | DBusProxyFlagsDoNotAutoStart | DBusProxyFlagsGetInvalidatedProperties | DBusProxyFlagsDoNotAutoStartAtConstruction | AnotherDBusProxyFlags Int deriving (Show, Eq) instance Enum DBusProxyFlags where fromEnum DBusProxyFlagsNone = 0 fromEnum DBusProxyFlagsDoNotLoadProperties = 1 fromEnum DBusProxyFlagsDoNotConnectSignals = 2 fromEnum DBusProxyFlagsDoNotAutoStart = 4 fromEnum DBusProxyFlagsGetInvalidatedProperties = 8 fromEnum DBusProxyFlagsDoNotAutoStartAtConstruction = 16 fromEnum (AnotherDBusProxyFlags k) = k toEnum 0 = DBusProxyFlagsNone toEnum 1 = DBusProxyFlagsDoNotLoadProperties toEnum 2 = DBusProxyFlagsDoNotConnectSignals toEnum 4 = DBusProxyFlagsDoNotAutoStart toEnum 8 = DBusProxyFlagsGetInvalidatedProperties toEnum 16 = DBusProxyFlagsDoNotAutoStartAtConstruction toEnum k = AnotherDBusProxyFlags k foreign import ccall "g_dbus_proxy_flags_get_type" c_g_dbus_proxy_flags_get_type :: IO GType instance BoxedEnum DBusProxyFlags where boxedEnumType _ = c_g_dbus_proxy_flags_get_type instance IsGFlag DBusProxyFlags -- callback DBusProxyTypeFunc dBusProxyTypeFuncClosure :: DBusProxyTypeFunc -> IO Closure dBusProxyTypeFuncClosure cb = newCClosure =<< mkDBusProxyTypeFunc wrapped where wrapped = dBusProxyTypeFuncWrapper Nothing cb type DBusProxyTypeFuncC = Ptr DBusObjectManagerClient -> CString -> CString -> Ptr () -> IO CGType foreign import ccall "wrapper" mkDBusProxyTypeFunc :: DBusProxyTypeFuncC -> IO (FunPtr DBusProxyTypeFuncC) type DBusProxyTypeFunc = DBusObjectManagerClient -> T.Text -> Maybe T.Text -> IO GType noDBusProxyTypeFunc :: Maybe DBusProxyTypeFunc noDBusProxyTypeFunc = Nothing dBusProxyTypeFuncWrapper :: Maybe (Ptr (FunPtr (DBusProxyTypeFuncC))) -> DBusProxyTypeFunc -> Ptr DBusObjectManagerClient -> CString -> CString -> Ptr () -> IO CGType dBusProxyTypeFuncWrapper funptrptr _cb manager object_path interface_name _ = do manager' <- (newObject DBusObjectManagerClient) manager object_path' <- cstringToText object_path maybeInterface_name <- if interface_name == nullPtr then return Nothing else do interface_name' <- cstringToText interface_name return $ Just interface_name' result <- _cb manager' object_path' maybeInterface_name maybeReleaseFunPtr funptrptr let result' = gtypeToCGType result return result' -- Flags DBusSendMessageFlags data DBusSendMessageFlags = DBusSendMessageFlagsNone | DBusSendMessageFlagsPreserveSerial | AnotherDBusSendMessageFlags Int deriving (Show, Eq) instance Enum DBusSendMessageFlags where fromEnum DBusSendMessageFlagsNone = 0 fromEnum DBusSendMessageFlagsPreserveSerial = 1 fromEnum (AnotherDBusSendMessageFlags k) = k toEnum 0 = DBusSendMessageFlagsNone toEnum 1 = DBusSendMessageFlagsPreserveSerial toEnum k = AnotherDBusSendMessageFlags k foreign import ccall "g_dbus_send_message_flags_get_type" c_g_dbus_send_message_flags_get_type :: IO GType instance BoxedEnum DBusSendMessageFlags where boxedEnumType _ = c_g_dbus_send_message_flags_get_type instance IsGFlag DBusSendMessageFlags -- object DBusServer newtype DBusServer = DBusServer (ForeignPtr DBusServer) noDBusServer :: Maybe DBusServer noDBusServer = Nothing foreign import ccall "g_dbus_server_get_type" c_g_dbus_server_get_type :: IO GType type instance ParentTypes DBusServer = '[GObject.Object, Initable] instance GObject DBusServer where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_dbus_server_get_type class GObject o => DBusServerK o instance (GObject o, IsDescendantOf DBusServer o) => DBusServerK o toDBusServer :: DBusServerK o => o -> IO DBusServer toDBusServer = unsafeCastTo DBusServer -- method DBusServer::new_sync -- method type : Constructor -- Args : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusServerFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusServerFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "observer", argType = TInterface "Gio" "DBusAuthObserver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusServer" -- throws : True -- Skip return : False foreign import ccall "g_dbus_server_new_sync" g_dbus_server_new_sync :: CString -> -- address : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "DBusServerFlags" CString -> -- guid : TBasicType TUTF8 Ptr DBusAuthObserver -> -- observer : TInterface "Gio" "DBusAuthObserver" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusServer) dBusServerNewSync :: (MonadIO m, DBusAuthObserverK a, CancellableK b) => T.Text -> -- address [DBusServerFlags] -> -- flags T.Text -> -- guid Maybe (a) -> -- observer Maybe (b) -> -- cancellable m DBusServer dBusServerNewSync address flags guid observer cancellable = liftIO $ do address' <- textToCString address let flags' = gflagsToWord flags guid' <- textToCString guid maybeObserver <- case observer of Nothing -> return nullPtr Just jObserver -> do let jObserver' = unsafeManagedPtrCastPtr jObserver return jObserver' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_server_new_sync address' flags' guid' maybeObserver maybeCancellable checkUnexpectedReturnNULL "g_dbus_server_new_sync" result result' <- (wrapObject DBusServer) result whenJust observer touchManagedPtr whenJust cancellable touchManagedPtr freeMem address' freeMem guid' return result' ) (do freeMem address' freeMem guid' ) -- method DBusServer::get_client_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_server_get_client_address" g_dbus_server_get_client_address :: Ptr DBusServer -> -- _obj : TInterface "Gio" "DBusServer" IO CString dBusServerGetClientAddress :: (MonadIO m, DBusServerK a) => a -> -- _obj m T.Text dBusServerGetClientAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_server_get_client_address _obj' checkUnexpectedReturnNULL "g_dbus_server_get_client_address" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusServer::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusServerFlags" -- throws : False -- Skip return : False foreign import ccall "g_dbus_server_get_flags" g_dbus_server_get_flags :: Ptr DBusServer -> -- _obj : TInterface "Gio" "DBusServer" IO CUInt dBusServerGetFlags :: (MonadIO m, DBusServerK a) => a -> -- _obj m [DBusServerFlags] dBusServerGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_server_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method DBusServer::get_guid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_server_get_guid" g_dbus_server_get_guid :: Ptr DBusServer -> -- _obj : TInterface "Gio" "DBusServer" IO CString dBusServerGetGuid :: (MonadIO m, DBusServerK a) => a -> -- _obj m T.Text dBusServerGetGuid _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_server_get_guid _obj' checkUnexpectedReturnNULL "g_dbus_server_get_guid" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DBusServer::is_active -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_server_is_active" g_dbus_server_is_active :: Ptr DBusServer -> -- _obj : TInterface "Gio" "DBusServer" IO CInt dBusServerIsActive :: (MonadIO m, DBusServerK a) => a -> -- _obj m Bool dBusServerIsActive _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_dbus_server_is_active _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method DBusServer::start -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_server_start" g_dbus_server_start :: Ptr DBusServer -> -- _obj : TInterface "Gio" "DBusServer" IO () dBusServerStart :: (MonadIO m, DBusServerK a) => a -> -- _obj m () dBusServerStart _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_server_start _obj' touchManagedPtr _obj return () -- method DBusServer::stop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusServer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_server_stop" g_dbus_server_stop :: Ptr DBusServer -> -- _obj : TInterface "Gio" "DBusServer" IO () dBusServerStop :: (MonadIO m, DBusServerK a) => a -> -- _obj m () dBusServerStop _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_dbus_server_stop _obj' touchManagedPtr _obj return () -- signal DBusServer::new-connection type DBusServerNewConnectionCallback = DBusConnection -> IO Bool noDBusServerNewConnectionCallback :: Maybe DBusServerNewConnectionCallback noDBusServerNewConnectionCallback = Nothing type DBusServerNewConnectionCallbackC = Ptr () -> -- object Ptr DBusConnection -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkDBusServerNewConnectionCallback :: DBusServerNewConnectionCallbackC -> IO (FunPtr DBusServerNewConnectionCallbackC) dBusServerNewConnectionClosure :: DBusServerNewConnectionCallback -> IO Closure dBusServerNewConnectionClosure cb = newCClosure =<< mkDBusServerNewConnectionCallback wrapped where wrapped = dBusServerNewConnectionCallbackWrapper cb dBusServerNewConnectionCallbackWrapper :: DBusServerNewConnectionCallback -> Ptr () -> Ptr DBusConnection -> Ptr () -> IO CInt dBusServerNewConnectionCallbackWrapper _cb _ connection _ = do connection' <- (newObject DBusConnection) connection result <- _cb connection' let result' = (fromIntegral . fromEnum) result return result' onDBusServerNewConnection :: (GObject a, MonadIO m) => a -> DBusServerNewConnectionCallback -> m SignalHandlerId onDBusServerNewConnection obj cb = liftIO $ connectDBusServerNewConnection obj cb SignalConnectBefore afterDBusServerNewConnection :: (GObject a, MonadIO m) => a -> DBusServerNewConnectionCallback -> m SignalHandlerId afterDBusServerNewConnection obj cb = connectDBusServerNewConnection obj cb SignalConnectAfter connectDBusServerNewConnection :: (GObject a, MonadIO m) => a -> DBusServerNewConnectionCallback -> SignalConnectMode -> m SignalHandlerId connectDBusServerNewConnection obj cb after = liftIO $ do cb' <- mkDBusServerNewConnectionCallback (dBusServerNewConnectionCallbackWrapper cb) connectSignalFunPtr obj "new-connection" cb' after -- Flags DBusServerFlags data DBusServerFlags = DBusServerFlagsNone | DBusServerFlagsRunInThread | DBusServerFlagsAuthenticationAllowAnonymous | AnotherDBusServerFlags Int deriving (Show, Eq) instance Enum DBusServerFlags where fromEnum DBusServerFlagsNone = 0 fromEnum DBusServerFlagsRunInThread = 1 fromEnum DBusServerFlagsAuthenticationAllowAnonymous = 2 fromEnum (AnotherDBusServerFlags k) = k toEnum 0 = DBusServerFlagsNone toEnum 1 = DBusServerFlagsRunInThread toEnum 2 = DBusServerFlagsAuthenticationAllowAnonymous toEnum k = AnotherDBusServerFlags k foreign import ccall "g_dbus_server_flags_get_type" c_g_dbus_server_flags_get_type :: IO GType instance BoxedEnum DBusServerFlags where boxedEnumType _ = c_g_dbus_server_flags_get_type instance IsGFlag DBusServerFlags -- callback DBusSignalCallback dBusSignalCallbackClosure :: DBusSignalCallback -> IO Closure dBusSignalCallbackClosure cb = newCClosure =<< mkDBusSignalCallback wrapped where wrapped = dBusSignalCallbackWrapper Nothing cb type DBusSignalCallbackC = Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr GVariant -> Ptr () -> IO () foreign import ccall "wrapper" mkDBusSignalCallback :: DBusSignalCallbackC -> IO (FunPtr DBusSignalCallbackC) type DBusSignalCallback = DBusConnection -> T.Text -> T.Text -> T.Text -> T.Text -> GVariant -> IO () noDBusSignalCallback :: Maybe DBusSignalCallback noDBusSignalCallback = Nothing dBusSignalCallbackWrapper :: Maybe (Ptr (FunPtr (DBusSignalCallbackC))) -> DBusSignalCallback -> Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr GVariant -> Ptr () -> IO () dBusSignalCallbackWrapper funptrptr _cb connection sender_name object_path interface_name signal_name parameters _ = do connection' <- (newObject DBusConnection) connection sender_name' <- cstringToText sender_name object_path' <- cstringToText object_path interface_name' <- cstringToText interface_name signal_name' <- cstringToText signal_name parameters' <- newGVariantFromPtr parameters _cb connection' sender_name' object_path' interface_name' signal_name' parameters' maybeReleaseFunPtr funptrptr -- Flags DBusSignalFlags data DBusSignalFlags = DBusSignalFlagsNone | DBusSignalFlagsNoMatchRule | DBusSignalFlagsMatchArg0Namespace | DBusSignalFlagsMatchArg0Path | AnotherDBusSignalFlags Int deriving (Show, Eq) instance Enum DBusSignalFlags where fromEnum DBusSignalFlagsNone = 0 fromEnum DBusSignalFlagsNoMatchRule = 1 fromEnum DBusSignalFlagsMatchArg0Namespace = 2 fromEnum DBusSignalFlagsMatchArg0Path = 4 fromEnum (AnotherDBusSignalFlags k) = k toEnum 0 = DBusSignalFlagsNone toEnum 1 = DBusSignalFlagsNoMatchRule toEnum 2 = DBusSignalFlagsMatchArg0Namespace toEnum 4 = DBusSignalFlagsMatchArg0Path toEnum k = AnotherDBusSignalFlags k foreign import ccall "g_dbus_signal_flags_get_type" c_g_dbus_signal_flags_get_type :: IO GType instance BoxedEnum DBusSignalFlags where boxedEnumType _ = c_g_dbus_signal_flags_get_type instance IsGFlag DBusSignalFlags -- struct DBusSignalInfo newtype DBusSignalInfo = DBusSignalInfo (ForeignPtr DBusSignalInfo) noDBusSignalInfo :: Maybe DBusSignalInfo noDBusSignalInfo = Nothing foreign import ccall "g_dbus_signal_info_get_type" c_g_dbus_signal_info_get_type :: IO GType instance BoxedObject DBusSignalInfo where boxedType _ = c_g_dbus_signal_info_get_type dBusSignalInfoReadRefCount :: DBusSignalInfo -> IO Int32 dBusSignalInfoReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val dBusSignalInfoReadName :: DBusSignalInfo -> IO T.Text dBusSignalInfoReadName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' dBusSignalInfoReadArgs :: DBusSignalInfo -> IO [DBusArgInfo] dBusSignalInfoReadArgs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr (Ptr DBusArgInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusArgInfo) val' return val'' dBusSignalInfoReadAnnotations :: DBusSignalInfo -> IO [DBusAnnotationInfo] dBusSignalInfoReadAnnotations s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr (Ptr DBusAnnotationInfo)) val' <- unpackZeroTerminatedPtrArray val val'' <- mapM (newBoxed DBusAnnotationInfo) val' return val'' -- method DBusSignalInfo::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusSignalInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusSignalInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusSignalInfo" -- throws : False -- Skip return : False foreign import ccall "g_dbus_signal_info_ref" g_dbus_signal_info_ref :: Ptr DBusSignalInfo -> -- _obj : TInterface "Gio" "DBusSignalInfo" IO (Ptr DBusSignalInfo) dBusSignalInfoRef :: (MonadIO m) => DBusSignalInfo -> -- _obj m DBusSignalInfo dBusSignalInfoRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_dbus_signal_info_ref _obj' checkUnexpectedReturnNULL "g_dbus_signal_info_ref" result result' <- (wrapBoxed DBusSignalInfo) result touchManagedPtr _obj return result' -- method DBusSignalInfo::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusSignalInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusSignalInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_signal_info_unref" g_dbus_signal_info_unref :: Ptr DBusSignalInfo -> -- _obj : TInterface "Gio" "DBusSignalInfo" IO () dBusSignalInfoUnref :: (MonadIO m) => DBusSignalInfo -> -- _obj m () dBusSignalInfoUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_dbus_signal_info_unref _obj' touchManagedPtr _obj return () -- callback DBusSubtreeDispatchFunc dBusSubtreeDispatchFuncClosure :: DBusSubtreeDispatchFunc -> IO Closure dBusSubtreeDispatchFuncClosure cb = newCClosure =<< mkDBusSubtreeDispatchFunc wrapped where wrapped = dBusSubtreeDispatchFuncWrapper Nothing cb type DBusSubtreeDispatchFuncC = Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr () -> Ptr () -> IO (Ptr DBusInterfaceVTable) foreign import ccall "wrapper" mkDBusSubtreeDispatchFunc :: DBusSubtreeDispatchFuncC -> IO (FunPtr DBusSubtreeDispatchFuncC) type DBusSubtreeDispatchFunc = DBusConnection -> T.Text -> T.Text -> T.Text -> T.Text -> Ptr () -> IO DBusInterfaceVTable noDBusSubtreeDispatchFunc :: Maybe DBusSubtreeDispatchFunc noDBusSubtreeDispatchFunc = Nothing dBusSubtreeDispatchFuncWrapper :: Maybe (Ptr (FunPtr (DBusSubtreeDispatchFuncC))) -> DBusSubtreeDispatchFunc -> Ptr DBusConnection -> CString -> CString -> CString -> CString -> Ptr () -> Ptr () -> IO (Ptr DBusInterfaceVTable) dBusSubtreeDispatchFuncWrapper funptrptr _cb connection sender object_path interface_name node out_user_data _ = do connection' <- (newObject DBusConnection) connection sender' <- cstringToText sender object_path' <- cstringToText object_path interface_name' <- cstringToText interface_name node' <- cstringToText node result <- _cb connection' sender' object_path' interface_name' node' out_user_data maybeReleaseFunPtr funptrptr let result' = unsafeManagedPtrGetPtr result return result' -- Flags DBusSubtreeFlags data DBusSubtreeFlags = DBusSubtreeFlagsNone | DBusSubtreeFlagsDispatchToUnenumeratedNodes | AnotherDBusSubtreeFlags Int deriving (Show, Eq) instance Enum DBusSubtreeFlags where fromEnum DBusSubtreeFlagsNone = 0 fromEnum DBusSubtreeFlagsDispatchToUnenumeratedNodes = 1 fromEnum (AnotherDBusSubtreeFlags k) = k toEnum 0 = DBusSubtreeFlagsNone toEnum 1 = DBusSubtreeFlagsDispatchToUnenumeratedNodes toEnum k = AnotherDBusSubtreeFlags k foreign import ccall "g_dbus_subtree_flags_get_type" c_g_dbus_subtree_flags_get_type :: IO GType instance BoxedEnum DBusSubtreeFlags where boxedEnumType _ = c_g_dbus_subtree_flags_get_type instance IsGFlag DBusSubtreeFlags -- callback DBusSubtreeIntrospectFunc dBusSubtreeIntrospectFuncClosure :: DBusSubtreeIntrospectFunc -> IO Closure dBusSubtreeIntrospectFuncClosure cb = newCClosure =<< mkDBusSubtreeIntrospectFunc wrapped where wrapped = dBusSubtreeIntrospectFuncWrapper Nothing cb type DBusSubtreeIntrospectFuncC = Ptr DBusConnection -> CString -> CString -> CString -> Ptr () -> IO (Ptr DBusInterfaceInfo) foreign import ccall "wrapper" mkDBusSubtreeIntrospectFunc :: DBusSubtreeIntrospectFuncC -> IO (FunPtr DBusSubtreeIntrospectFuncC) type DBusSubtreeIntrospectFunc = DBusConnection -> T.Text -> T.Text -> T.Text -> IO DBusInterfaceInfo noDBusSubtreeIntrospectFunc :: Maybe DBusSubtreeIntrospectFunc noDBusSubtreeIntrospectFunc = Nothing dBusSubtreeIntrospectFuncWrapper :: Maybe (Ptr (FunPtr (DBusSubtreeIntrospectFuncC))) -> DBusSubtreeIntrospectFunc -> Ptr DBusConnection -> CString -> CString -> CString -> Ptr () -> IO (Ptr DBusInterfaceInfo) dBusSubtreeIntrospectFuncWrapper funptrptr _cb connection sender object_path node _ = do connection' <- (newObject DBusConnection) connection sender' <- cstringToText sender object_path' <- cstringToText object_path node' <- cstringToText node result <- _cb connection' sender' object_path' node' maybeReleaseFunPtr funptrptr result' <- copyBoxed result return result' -- struct DBusSubtreeVTable newtype DBusSubtreeVTable = DBusSubtreeVTable (ForeignPtr DBusSubtreeVTable) noDBusSubtreeVTable :: Maybe DBusSubtreeVTable noDBusSubtreeVTable = Nothing -- XXX Skipped getter for "DBusSubtreeVTable:introspect" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "DBusSubtreeVTable:dispatch" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- object DataInputStream newtype DataInputStream = DataInputStream (ForeignPtr DataInputStream) noDataInputStream :: Maybe DataInputStream noDataInputStream = Nothing foreign import ccall "g_data_input_stream_get_type" c_g_data_input_stream_get_type :: IO GType type instance ParentTypes DataInputStream = '[BufferedInputStream, FilterInputStream, InputStream, GObject.Object, Seekable] instance GObject DataInputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_data_input_stream_get_type class GObject o => DataInputStreamK o instance (GObject o, IsDescendantOf DataInputStream o) => DataInputStreamK o toDataInputStream :: DataInputStreamK o => o -> IO DataInputStream toDataInputStream = unsafeCastTo DataInputStream -- method DataInputStream::new -- method type : Constructor -- Args : [Arg {argName = "base_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DataInputStream" -- throws : False -- Skip return : False foreign import ccall "g_data_input_stream_new" g_data_input_stream_new :: Ptr InputStream -> -- base_stream : TInterface "Gio" "InputStream" IO (Ptr DataInputStream) dataInputStreamNew :: (MonadIO m, InputStreamK a) => a -> -- base_stream m DataInputStream dataInputStreamNew base_stream = liftIO $ do let base_stream' = unsafeManagedPtrCastPtr base_stream result <- g_data_input_stream_new base_stream' checkUnexpectedReturnNULL "g_data_input_stream_new" result result' <- (wrapObject DataInputStream) result touchManagedPtr base_stream return result' -- method DataInputStream::get_byte_order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DataStreamByteOrder" -- throws : False -- Skip return : False foreign import ccall "g_data_input_stream_get_byte_order" g_data_input_stream_get_byte_order :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" IO CUInt dataInputStreamGetByteOrder :: (MonadIO m, DataInputStreamK a) => a -> -- _obj m DataStreamByteOrder dataInputStreamGetByteOrder _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_data_input_stream_get_byte_order _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method DataInputStream::get_newline_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DataStreamNewlineType" -- throws : False -- Skip return : False foreign import ccall "g_data_input_stream_get_newline_type" g_data_input_stream_get_newline_type :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" IO CUInt dataInputStreamGetNewlineType :: (MonadIO m, DataInputStreamK a) => a -> -- _obj m DataStreamNewlineType dataInputStreamGetNewlineType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_data_input_stream_get_newline_type _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method DataInputStream::read_byte -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt8 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_byte" g_data_input_stream_read_byte :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Word8 dataInputStreamReadByte :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Word8 dataInputStreamReadByte _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_byte _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method DataInputStream::read_int16 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt16 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_int16" g_data_input_stream_read_int16 :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int16 dataInputStreamReadInt16 :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Int16 dataInputStreamReadInt16 _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_int16 _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method DataInputStream::read_int32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_int32" g_data_input_stream_read_int32 :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int32 dataInputStreamReadInt32 :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Int32 dataInputStreamReadInt32 _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_int32 _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method DataInputStream::read_int64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_int64" g_data_input_stream_read_int64 :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 dataInputStreamReadInt64 :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Int64 dataInputStreamReadInt64 _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_int64 _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method DataInputStream::read_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUInt8) -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_line" g_data_input_stream_read_line :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Word64 -> -- length : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr Word8) dataInputStreamReadLine :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m (ByteString,Word64) dataInputStreamReadLine _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj length_ <- allocMem :: IO (Ptr Word64) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_line _obj' length_ maybeCancellable checkUnexpectedReturnNULL "g_data_input_stream_read_line" result result' <- unpackZeroTerminatedByteString result freeMem result length_' <- peek length_ touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem length_ return (result', length_') ) (do freeMem length_ ) -- method DataInputStream::read_line_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_data_input_stream_read_line_async" g_data_input_stream_read_line_async :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dataInputStreamReadLineAsync :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dataInputStreamReadLineAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_data_input_stream_read_line_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method DataInputStream::read_line_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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 "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUInt8) -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_line_finish" g_data_input_stream_read_line_finish :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO (Ptr Word8) dataInputStreamReadLineFinish :: (MonadIO m, DataInputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m (ByteString,Word64) dataInputStreamReadLineFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_data_input_stream_read_line_finish _obj' result_' length_ checkUnexpectedReturnNULL "g_data_input_stream_read_line_finish" result result' <- unpackZeroTerminatedByteString result freeMem result length_' <- peek length_ touchManagedPtr _obj touchManagedPtr result_ freeMem length_ return (result', length_') ) (do freeMem length_ ) -- method DataInputStream::read_line_finish_utf8 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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 "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_line_finish_utf8" g_data_input_stream_read_line_finish_utf8 :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString dataInputStreamReadLineFinishUtf8 :: (MonadIO m, DataInputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m (T.Text,Word64) dataInputStreamReadLineFinishUtf8 _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_data_input_stream_read_line_finish_utf8 _obj' result_' length_ checkUnexpectedReturnNULL "g_data_input_stream_read_line_finish_utf8" result result' <- cstringToText result freeMem result length_' <- peek length_ touchManagedPtr _obj touchManagedPtr result_ freeMem length_ return (result', length_') ) (do freeMem length_ ) -- method DataInputStream::read_line_utf8 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_line_utf8" g_data_input_stream_read_line_utf8 :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Word64 -> -- length : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CString dataInputStreamReadLineUtf8 :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m (T.Text,Word64) dataInputStreamReadLineUtf8 _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj length_ <- allocMem :: IO (Ptr Word64) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_line_utf8 _obj' length_ maybeCancellable checkUnexpectedReturnNULL "g_data_input_stream_read_line_utf8" result result' <- cstringToText result freeMem result length_' <- peek length_ touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem length_ return (result', length_') ) (do freeMem length_ ) -- method DataInputStream::read_uint16 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_uint16" g_data_input_stream_read_uint16 :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Word16 dataInputStreamReadUint16 :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Word16 dataInputStreamReadUint16 _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_uint16 _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method DataInputStream::read_uint32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_uint32" g_data_input_stream_read_uint32 :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Word32 dataInputStreamReadUint32 :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Word32 dataInputStreamReadUint32 _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_uint32 _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method DataInputStream::read_uint64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_uint64" g_data_input_stream_read_uint64 :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Word64 dataInputStreamReadUint64 :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Word64 dataInputStreamReadUint64 _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_uint64 _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method DataInputStream::read_until -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars", 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_until" g_data_input_stream_read_until :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" CString -> -- stop_chars : TBasicType TUTF8 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CString dataInputStreamReadUntil :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- stop_chars Maybe (b) -> -- cancellable m (T.Text,Word64) dataInputStreamReadUntil _obj stop_chars cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj stop_chars' <- textToCString stop_chars length_ <- allocMem :: IO (Ptr Word64) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_until _obj' stop_chars' length_ maybeCancellable checkUnexpectedReturnNULL "g_data_input_stream_read_until" result result' <- cstringToText result freeMem result length_' <- peek length_ touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem stop_chars' freeMem length_ return (result', length_') ) (do freeMem stop_chars' freeMem length_ ) -- method DataInputStream::read_until_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_data_input_stream_read_until_async" g_data_input_stream_read_until_async :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" CString -> -- stop_chars : TBasicType TUTF8 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dataInputStreamReadUntilAsync :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- stop_chars Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dataInputStreamReadUntilAsync _obj stop_chars io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj stop_chars' <- textToCString stop_chars maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_data_input_stream_read_until_async _obj' stop_chars' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem stop_chars' return () -- method DataInputStream::read_until_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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 "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_until_finish" g_data_input_stream_read_until_finish :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString dataInputStreamReadUntilFinish :: (MonadIO m, DataInputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m (T.Text,Word64) dataInputStreamReadUntilFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_data_input_stream_read_until_finish _obj' result_' length_ checkUnexpectedReturnNULL "g_data_input_stream_read_until_finish" result result' <- cstringToText result freeMem result length_' <- peek length_ touchManagedPtr _obj touchManagedPtr result_ freeMem length_ return (result', length_') ) (do freeMem length_ ) -- method DataInputStream::read_upto -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars_len", argType = TBasicType TInt64, 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_upto" g_data_input_stream_read_upto :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" CString -> -- stop_chars : TBasicType TUTF8 Int64 -> -- stop_chars_len : TBasicType TInt64 Ptr Word64 -> -- length : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CString dataInputStreamReadUpto :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- stop_chars Int64 -> -- stop_chars_len Maybe (b) -> -- cancellable m (T.Text,Word64) dataInputStreamReadUpto _obj stop_chars stop_chars_len cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj stop_chars' <- textToCString stop_chars length_ <- allocMem :: IO (Ptr Word64) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_data_input_stream_read_upto _obj' stop_chars' stop_chars_len length_ maybeCancellable checkUnexpectedReturnNULL "g_data_input_stream_read_upto" result result' <- cstringToText result freeMem result length_' <- peek length_ touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem stop_chars' freeMem length_ return (result', length_') ) (do freeMem stop_chars' freeMem length_ ) -- method DataInputStream::read_upto_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stop_chars_len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_data_input_stream_read_upto_async" g_data_input_stream_read_upto_async :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" CString -> -- stop_chars : TBasicType TUTF8 Int64 -> -- stop_chars_len : TBasicType TInt64 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dataInputStreamReadUptoAsync :: (MonadIO m, DataInputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- stop_chars Int64 -> -- stop_chars_len Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dataInputStreamReadUptoAsync _obj stop_chars stop_chars_len io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj stop_chars' <- textToCString stop_chars maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_data_input_stream_read_upto_async _obj' stop_chars' stop_chars_len io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem stop_chars' return () -- method DataInputStream::read_upto_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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 "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_data_input_stream_read_upto_finish" g_data_input_stream_read_upto_finish :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr Word64 -> -- length : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CString dataInputStreamReadUptoFinish :: (MonadIO m, DataInputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m (T.Text,Word64) dataInputStreamReadUptoFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ length_ <- allocMem :: IO (Ptr Word64) onException (do result <- propagateGError $ g_data_input_stream_read_upto_finish _obj' result_' length_ checkUnexpectedReturnNULL "g_data_input_stream_read_upto_finish" result result' <- cstringToText result freeMem result length_' <- peek length_ touchManagedPtr _obj touchManagedPtr result_ freeMem length_ return (result', length_') ) (do freeMem length_ ) -- method DataInputStream::set_byte_order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "order", argType = TInterface "Gio" "DataStreamByteOrder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "order", argType = TInterface "Gio" "DataStreamByteOrder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_data_input_stream_set_byte_order" g_data_input_stream_set_byte_order :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" CUInt -> -- order : TInterface "Gio" "DataStreamByteOrder" IO () dataInputStreamSetByteOrder :: (MonadIO m, DataInputStreamK a) => a -> -- _obj DataStreamByteOrder -> -- order m () dataInputStreamSetByteOrder _obj order = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let order' = (fromIntegral . fromEnum) order g_data_input_stream_set_byte_order _obj' order' touchManagedPtr _obj return () -- method DataInputStream::set_newline_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "DataStreamNewlineType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "DataStreamNewlineType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_data_input_stream_set_newline_type" g_data_input_stream_set_newline_type :: Ptr DataInputStream -> -- _obj : TInterface "Gio" "DataInputStream" CUInt -> -- type : TInterface "Gio" "DataStreamNewlineType" IO () dataInputStreamSetNewlineType :: (MonadIO m, DataInputStreamK a) => a -> -- _obj DataStreamNewlineType -> -- type m () dataInputStreamSetNewlineType _obj type_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let type_' = (fromIntegral . fromEnum) type_ g_data_input_stream_set_newline_type _obj' type_' touchManagedPtr _obj return () -- object DataOutputStream newtype DataOutputStream = DataOutputStream (ForeignPtr DataOutputStream) noDataOutputStream :: Maybe DataOutputStream noDataOutputStream = Nothing foreign import ccall "g_data_output_stream_get_type" c_g_data_output_stream_get_type :: IO GType type instance ParentTypes DataOutputStream = '[FilterOutputStream, OutputStream, GObject.Object, Seekable] instance GObject DataOutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_data_output_stream_get_type class GObject o => DataOutputStreamK o instance (GObject o, IsDescendantOf DataOutputStream o) => DataOutputStreamK o toDataOutputStream :: DataOutputStreamK o => o -> IO DataOutputStream toDataOutputStream = unsafeCastTo DataOutputStream -- method DataOutputStream::new -- method type : Constructor -- Args : [Arg {argName = "base_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DataOutputStream" -- throws : False -- Skip return : False foreign import ccall "g_data_output_stream_new" g_data_output_stream_new :: Ptr OutputStream -> -- base_stream : TInterface "Gio" "OutputStream" IO (Ptr DataOutputStream) dataOutputStreamNew :: (MonadIO m, OutputStreamK a) => a -> -- base_stream m DataOutputStream dataOutputStreamNew base_stream = liftIO $ do let base_stream' = unsafeManagedPtrCastPtr base_stream result <- g_data_output_stream_new base_stream' checkUnexpectedReturnNULL "g_data_output_stream_new" result result' <- (wrapObject DataOutputStream) result touchManagedPtr base_stream return result' -- method DataOutputStream::get_byte_order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DataStreamByteOrder" -- throws : False -- Skip return : False foreign import ccall "g_data_output_stream_get_byte_order" g_data_output_stream_get_byte_order :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" IO CUInt dataOutputStreamGetByteOrder :: (MonadIO m, DataOutputStreamK a) => a -> -- _obj m DataStreamByteOrder dataOutputStreamGetByteOrder _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_data_output_stream_get_byte_order _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method DataOutputStream::put_byte -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_data_output_stream_put_byte" g_data_output_stream_put_byte :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" Word8 -> -- data : TBasicType TUInt8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dataOutputStreamPutByte :: (MonadIO m, DataOutputStreamK a, CancellableK b) => a -> -- _obj Word8 -> -- data Maybe (b) -> -- cancellable m () dataOutputStreamPutByte _obj data_ cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_data_output_stream_put_byte _obj' data_ maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DataOutputStream::put_int16 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_data_output_stream_put_int16" g_data_output_stream_put_int16 :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" Int16 -> -- data : TBasicType TInt16 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dataOutputStreamPutInt16 :: (MonadIO m, DataOutputStreamK a, CancellableK b) => a -> -- _obj Int16 -> -- data Maybe (b) -> -- cancellable m () dataOutputStreamPutInt16 _obj data_ cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_data_output_stream_put_int16 _obj' data_ maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DataOutputStream::put_int32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_data_output_stream_put_int32" g_data_output_stream_put_int32 :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" Int32 -> -- data : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dataOutputStreamPutInt32 :: (MonadIO m, DataOutputStreamK a, CancellableK b) => a -> -- _obj Int32 -> -- data Maybe (b) -> -- cancellable m () dataOutputStreamPutInt32 _obj data_ cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_data_output_stream_put_int32 _obj' data_ maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DataOutputStream::put_int64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_data_output_stream_put_int64" g_data_output_stream_put_int64 :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" Int64 -> -- data : TBasicType TInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dataOutputStreamPutInt64 :: (MonadIO m, DataOutputStreamK a, CancellableK b) => a -> -- _obj Int64 -> -- data Maybe (b) -> -- cancellable m () dataOutputStreamPutInt64 _obj data_ cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_data_output_stream_put_int64 _obj' data_ maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DataOutputStream::put_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_data_output_stream_put_string" g_data_output_stream_put_string :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" CString -> -- str : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dataOutputStreamPutString :: (MonadIO m, DataOutputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- str Maybe (b) -> -- cancellable m () dataOutputStreamPutString _obj str cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj str' <- textToCString str maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_data_output_stream_put_string _obj' str' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem str' return () ) (do freeMem str' ) -- method DataOutputStream::put_uint16 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_data_output_stream_put_uint16" g_data_output_stream_put_uint16 :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" Word16 -> -- data : TBasicType TUInt16 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dataOutputStreamPutUint16 :: (MonadIO m, DataOutputStreamK a, CancellableK b) => a -> -- _obj Word16 -> -- data Maybe (b) -> -- cancellable m () dataOutputStreamPutUint16 _obj data_ cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_data_output_stream_put_uint16 _obj' data_ maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DataOutputStream::put_uint32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_data_output_stream_put_uint32" g_data_output_stream_put_uint32 :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" Word32 -> -- data : TBasicType TUInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dataOutputStreamPutUint32 :: (MonadIO m, DataOutputStreamK a, CancellableK b) => a -> -- _obj Word32 -> -- data Maybe (b) -> -- cancellable m () dataOutputStreamPutUint32 _obj data_ cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_data_output_stream_put_uint32 _obj' data_ maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DataOutputStream::put_uint64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_data_output_stream_put_uint64" g_data_output_stream_put_uint64 :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" Word64 -> -- data : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt dataOutputStreamPutUint64 :: (MonadIO m, DataOutputStreamK a, CancellableK b) => a -> -- _obj Word64 -> -- data Maybe (b) -> -- cancellable m () dataOutputStreamPutUint64 _obj data_ cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_data_output_stream_put_uint64 _obj' data_ maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method DataOutputStream::set_byte_order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "order", argType = TInterface "Gio" "DataStreamByteOrder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DataOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "order", argType = TInterface "Gio" "DataStreamByteOrder", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_data_output_stream_set_byte_order" g_data_output_stream_set_byte_order :: Ptr DataOutputStream -> -- _obj : TInterface "Gio" "DataOutputStream" CUInt -> -- order : TInterface "Gio" "DataStreamByteOrder" IO () dataOutputStreamSetByteOrder :: (MonadIO m, DataOutputStreamK a) => a -> -- _obj DataStreamByteOrder -> -- order m () dataOutputStreamSetByteOrder _obj order = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let order' = (fromIntegral . fromEnum) order g_data_output_stream_set_byte_order _obj' order' touchManagedPtr _obj return () -- Enum DataStreamByteOrder data DataStreamByteOrder = DataStreamByteOrderBigEndian | DataStreamByteOrderLittleEndian | DataStreamByteOrderHostEndian | AnotherDataStreamByteOrder Int deriving (Show, Eq) instance Enum DataStreamByteOrder where fromEnum DataStreamByteOrderBigEndian = 0 fromEnum DataStreamByteOrderLittleEndian = 1 fromEnum DataStreamByteOrderHostEndian = 2 fromEnum (AnotherDataStreamByteOrder k) = k toEnum 0 = DataStreamByteOrderBigEndian toEnum 1 = DataStreamByteOrderLittleEndian toEnum 2 = DataStreamByteOrderHostEndian toEnum k = AnotherDataStreamByteOrder k foreign import ccall "g_data_stream_byte_order_get_type" c_g_data_stream_byte_order_get_type :: IO GType instance BoxedEnum DataStreamByteOrder where boxedEnumType _ = c_g_data_stream_byte_order_get_type -- Enum DataStreamNewlineType data DataStreamNewlineType = DataStreamNewlineTypeLf | DataStreamNewlineTypeCr | DataStreamNewlineTypeCrLf | DataStreamNewlineTypeAny | AnotherDataStreamNewlineType Int deriving (Show, Eq) instance Enum DataStreamNewlineType where fromEnum DataStreamNewlineTypeLf = 0 fromEnum DataStreamNewlineTypeCr = 1 fromEnum DataStreamNewlineTypeCrLf = 2 fromEnum DataStreamNewlineTypeAny = 3 fromEnum (AnotherDataStreamNewlineType k) = k toEnum 0 = DataStreamNewlineTypeLf toEnum 1 = DataStreamNewlineTypeCr toEnum 2 = DataStreamNewlineTypeCrLf toEnum 3 = DataStreamNewlineTypeAny toEnum k = AnotherDataStreamNewlineType k foreign import ccall "g_data_stream_newline_type_get_type" c_g_data_stream_newline_type_get_type :: IO GType instance BoxedEnum DataStreamNewlineType where boxedEnumType _ = c_g_data_stream_newline_type_get_type -- object DesktopAppInfo newtype DesktopAppInfo = DesktopAppInfo (ForeignPtr DesktopAppInfo) noDesktopAppInfo :: Maybe DesktopAppInfo noDesktopAppInfo = Nothing foreign import ccall "g_desktop_app_info_get_type" c_g_desktop_app_info_get_type :: IO GType type instance ParentTypes DesktopAppInfo = '[GObject.Object, AppInfo] instance GObject DesktopAppInfo where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_desktop_app_info_get_type class GObject o => DesktopAppInfoK o instance (GObject o, IsDescendantOf DesktopAppInfo o) => DesktopAppInfoK o toDesktopAppInfo :: DesktopAppInfoK o => o -> IO DesktopAppInfo toDesktopAppInfo = unsafeCastTo DesktopAppInfo -- method DesktopAppInfo::new -- method type : Constructor -- Args : [Arg {argName = "desktop_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "desktop_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DesktopAppInfo" -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_new" g_desktop_app_info_new :: CString -> -- desktop_id : TBasicType TUTF8 IO (Ptr DesktopAppInfo) desktopAppInfoNew :: (MonadIO m) => T.Text -> -- desktop_id m DesktopAppInfo desktopAppInfoNew desktop_id = liftIO $ do desktop_id' <- textToCString desktop_id result <- g_desktop_app_info_new desktop_id' checkUnexpectedReturnNULL "g_desktop_app_info_new" result result' <- (wrapObject DesktopAppInfo) result freeMem desktop_id' return result' -- method DesktopAppInfo::new_from_filename -- method type : Constructor -- 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 : TInterface "Gio" "DesktopAppInfo" -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_new_from_filename" g_desktop_app_info_new_from_filename :: CString -> -- filename : TBasicType TUTF8 IO (Ptr DesktopAppInfo) desktopAppInfoNewFromFilename :: (MonadIO m) => T.Text -> -- filename m DesktopAppInfo desktopAppInfoNewFromFilename filename = liftIO $ do filename' <- textToCString filename result <- g_desktop_app_info_new_from_filename filename' checkUnexpectedReturnNULL "g_desktop_app_info_new_from_filename" result result' <- (wrapObject DesktopAppInfo) result freeMem filename' return result' -- method DesktopAppInfo::new_from_keyfile -- method type : Constructor -- Args : [Arg {argName = "key_file", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "key_file", argType = TInterface "GLib" "KeyFile", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DesktopAppInfo" -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_new_from_keyfile" g_desktop_app_info_new_from_keyfile :: Ptr GLib.KeyFile -> -- key_file : TInterface "GLib" "KeyFile" IO (Ptr DesktopAppInfo) desktopAppInfoNewFromKeyfile :: (MonadIO m) => GLib.KeyFile -> -- key_file m DesktopAppInfo desktopAppInfoNewFromKeyfile key_file = liftIO $ do let key_file' = unsafeManagedPtrGetPtr key_file result <- g_desktop_app_info_new_from_keyfile key_file' checkUnexpectedReturnNULL "g_desktop_app_info_new_from_keyfile" result result' <- (wrapObject DesktopAppInfo) result touchManagedPtr key_file return result' -- method DesktopAppInfo::get_action_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_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_desktop_app_info_get_action_name" g_desktop_app_info_get_action_name :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" CString -> -- action_name : TBasicType TUTF8 IO CString desktopAppInfoGetActionName :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj T.Text -> -- action_name m T.Text desktopAppInfoGetActionName _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_desktop_app_info_get_action_name _obj' action_name' checkUnexpectedReturnNULL "g_desktop_app_info_get_action_name" result result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem action_name' return result' -- method DesktopAppInfo::get_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", 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 "Gio" "DesktopAppInfo", 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_desktop_app_info_get_boolean" g_desktop_app_info_get_boolean :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" CString -> -- key : TBasicType TUTF8 IO CInt desktopAppInfoGetBoolean :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj T.Text -> -- key m Bool desktopAppInfoGetBoolean _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_desktop_app_info_get_boolean _obj' key' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method DesktopAppInfo::get_categories -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_get_categories" g_desktop_app_info_get_categories :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" IO CString desktopAppInfoGetCategories :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj m T.Text desktopAppInfoGetCategories _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_desktop_app_info_get_categories _obj' checkUnexpectedReturnNULL "g_desktop_app_info_get_categories" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DesktopAppInfo::get_filename -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_get_filename" g_desktop_app_info_get_filename :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" IO CString desktopAppInfoGetFilename :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj m T.Text desktopAppInfoGetFilename _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_desktop_app_info_get_filename _obj' checkUnexpectedReturnNULL "g_desktop_app_info_get_filename" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DesktopAppInfo::get_generic_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_get_generic_name" g_desktop_app_info_get_generic_name :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" IO CString desktopAppInfoGetGenericName :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj m T.Text desktopAppInfoGetGenericName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_desktop_app_info_get_generic_name _obj' checkUnexpectedReturnNULL "g_desktop_app_info_get_generic_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DesktopAppInfo::get_is_hidden -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_get_is_hidden" g_desktop_app_info_get_is_hidden :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" IO CInt desktopAppInfoGetIsHidden :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj m Bool desktopAppInfoGetIsHidden _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_desktop_app_info_get_is_hidden _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method DesktopAppInfo::get_keywords -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", 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_desktop_app_info_get_keywords" g_desktop_app_info_get_keywords :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" IO (Ptr CString) desktopAppInfoGetKeywords :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj m [T.Text] desktopAppInfoGetKeywords _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_desktop_app_info_get_keywords _obj' checkUnexpectedReturnNULL "g_desktop_app_info_get_keywords" result result' <- unpackZeroTerminatedUTF8CArray result touchManagedPtr _obj return result' -- method DesktopAppInfo::get_nodisplay -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_get_nodisplay" g_desktop_app_info_get_nodisplay :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" IO CInt desktopAppInfoGetNodisplay :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj m Bool desktopAppInfoGetNodisplay _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_desktop_app_info_get_nodisplay _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method DesktopAppInfo::get_show_in -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desktop_env", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desktop_env", 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_desktop_app_info_get_show_in" g_desktop_app_info_get_show_in :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" CString -> -- desktop_env : TBasicType TUTF8 IO CInt desktopAppInfoGetShowIn :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj Maybe (T.Text) -> -- desktop_env m Bool desktopAppInfoGetShowIn _obj desktop_env = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeDesktop_env <- case desktop_env of Nothing -> return nullPtr Just jDesktop_env -> do jDesktop_env' <- textToCString jDesktop_env return jDesktop_env' result <- g_desktop_app_info_get_show_in _obj' maybeDesktop_env let result' = (/= 0) result touchManagedPtr _obj freeMem maybeDesktop_env return result' -- method DesktopAppInfo::get_startup_wm_class -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_get_startup_wm_class" g_desktop_app_info_get_startup_wm_class :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" IO CString desktopAppInfoGetStartupWmClass :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj m T.Text desktopAppInfoGetStartupWmClass _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_desktop_app_info_get_startup_wm_class _obj' checkUnexpectedReturnNULL "g_desktop_app_info_get_startup_wm_class" result result' <- cstringToText result touchManagedPtr _obj return result' -- method DesktopAppInfo::get_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", 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 "Gio" "DesktopAppInfo", 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 : False -- Skip return : False foreign import ccall "g_desktop_app_info_get_string" g_desktop_app_info_get_string :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" CString -> -- key : TBasicType TUTF8 IO CString desktopAppInfoGetString :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj T.Text -> -- key m T.Text desktopAppInfoGetString _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_desktop_app_info_get_string _obj' key' checkUnexpectedReturnNULL "g_desktop_app_info_get_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem key' return result' -- method DesktopAppInfo::has_key -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", 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 "Gio" "DesktopAppInfo", 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_desktop_app_info_has_key" g_desktop_app_info_has_key :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" CString -> -- key : TBasicType TUTF8 IO CInt desktopAppInfoHasKey :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj T.Text -> -- key m Bool desktopAppInfoHasKey _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_desktop_app_info_has_key _obj' key' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method DesktopAppInfo::launch_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "launch_context", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "launch_context", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_launch_action" g_desktop_app_info_launch_action :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" CString -> -- action_name : TBasicType TUTF8 Ptr AppLaunchContext -> -- launch_context : TInterface "Gio" "AppLaunchContext" IO () desktopAppInfoLaunchAction :: (MonadIO m, DesktopAppInfoK a, AppLaunchContextK b) => a -> -- _obj T.Text -> -- action_name Maybe (b) -> -- launch_context m () desktopAppInfoLaunchAction _obj action_name launch_context = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name maybeLaunch_context <- case launch_context of Nothing -> return nullPtr Just jLaunch_context -> do let jLaunch_context' = unsafeManagedPtrCastPtr jLaunch_context return jLaunch_context' g_desktop_app_info_launch_action _obj' action_name' maybeLaunch_context touchManagedPtr _obj whenJust launch_context touchManagedPtr freeMem action_name' return () -- XXX Could not generate method DesktopAppInfo::launch_uris_as_manager -- Error was : Bad introspection data: "Closure not found! Callable\n { returnType = TBasicType TBoolean\n , returnMayBeNull = False\n , returnTransfer = TransferNothing\n , args =\n [ Arg\n { argName = \"_obj\"\n , argType = TInterface \"Gio\" \"DesktopAppInfo\"\n , direction = DirectionIn\n , mayBeNull = False\n , argScope = ScopeTypeInvalid\n , argClosure = -1\n , argDestroy = -1\n , transfer = TransferNothing\n }\n , Arg\n { argName = \"uris\"\n , argType = TGList (TBasicType TUTF8)\n , direction = DirectionIn\n , mayBeNull = False\n , argScope = ScopeTypeInvalid\n , argClosure = -1\n , argDestroy = -1\n , transfer = TransferNothing\n }\n , Arg\n { argName = \"launch_context\"\n , argType = TInterface \"Gio\" \"AppLaunchContext\"\n , direction = DirectionIn\n , mayBeNull = True\n , argScope = ScopeTypeInvalid\n , argClosure = -1\n , argDestroy = -1\n , transfer = TransferNothing\n }\n , Arg\n { argName = \"spawn_flags\"\n , argType = TInterface \"GLib\" \"SpawnFlags\"\n , direction = DirectionIn\n , mayBeNull = False\n , argScope = ScopeTypeInvalid\n , argClosure = -1\n , argDestroy = -1\n , transfer = TransferNothing\n }\n , Arg\n { argName = \"user_setup\"\n , argType = TInterface \"GLib\" \"SpawnChildSetupFunc\"\n , direction = DirectionIn\n , mayBeNull = True\n , argScope = ScopeTypeCall\n , argClosure = 5\n , argDestroy = -1\n , transfer = TransferNothing\n }\n , Arg\n { argName = \"user_setup_data\"\n , argType = TBasicType TVoid\n , direction = DirectionIn\n , mayBeNull = True\n , argScope = ScopeTypeInvalid\n , argClosure = 4\n , argDestroy = -1\n , transfer = TransferNothing\n }\n , Arg\n { argName = \"pid_callback\"\n , argType = TInterface \"Gio\" \"DesktopAppLaunchCallback\"\n , direction = DirectionIn\n , mayBeNull = True\n , argScope = ScopeTypeCall\n , argClosure = 7\n , argDestroy = -1\n , transfer = TransferNothing\n }\n , Arg\n { argName = \"pid_callback_data\"\n , argType = TBasicType TVoid\n , direction = DirectionIn\n , mayBeNull = True\n , argScope = ScopeTypeInvalid\n , argClosure = 6\n , argDestroy = -1\n , transfer = TransferNothing\n }\n ]\n , skipReturn = False\n , callableDeprecated = Nothing\n }\nfromList\n [ ( 5\n , Arg\n { argName = \"user_setup\"\n , argType = TInterface \"GLib\" \"SpawnChildSetupFunc\"\n , direction = DirectionIn\n , mayBeNull = True\n , argScope = ScopeTypeCall\n , argClosure = 5\n , argDestroy = -1\n , transfer = TransferNothing\n }\n )\n , ( 7\n , Arg\n { argName = \"pid_callback\"\n , argType = TInterface \"Gio\" \"DesktopAppLaunchCallback\"\n , direction = DirectionIn\n , mayBeNull = True\n , argScope = ScopeTypeCall\n , argClosure = 7\n , argDestroy = -1\n , transfer = TransferNothing\n }\n )\n ]\n4" -- method DesktopAppInfo::list_actions -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfo", 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_desktop_app_info_list_actions" g_desktop_app_info_list_actions :: Ptr DesktopAppInfo -> -- _obj : TInterface "Gio" "DesktopAppInfo" IO (Ptr CString) desktopAppInfoListActions :: (MonadIO m, DesktopAppInfoK a) => a -> -- _obj m [T.Text] desktopAppInfoListActions _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_desktop_app_info_list_actions _obj' checkUnexpectedReturnNULL "g_desktop_app_info_list_actions" result result' <- unpackZeroTerminatedUTF8CArray result touchManagedPtr _obj return result' -- method DesktopAppInfo::get_implementations -- method type : MemberFunction -- Args : [Arg {argName = "interface", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "interface", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "DesktopAppInfo") -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_get_implementations" g_desktop_app_info_get_implementations :: CString -> -- interface : TBasicType TUTF8 IO (Ptr (GList (Ptr DesktopAppInfo))) desktopAppInfoGetImplementations :: (MonadIO m) => T.Text -> -- interface m [DesktopAppInfo] desktopAppInfoGetImplementations interface = liftIO $ do interface' <- textToCString interface result <- g_desktop_app_info_get_implementations interface' checkUnexpectedReturnNULL "g_desktop_app_info_get_implementations" result result' <- unpackGList result result'' <- mapM (wrapObject DesktopAppInfo) result' g_list_free result freeMem interface' return result'' -- method DesktopAppInfo::search -- method type : MemberFunction -- Args : [Arg {argName = "search_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "search_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TCArray True (-1) (-1) (TBasicType TUTF8)) -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_search" g_desktop_app_info_search :: CString -> -- search_string : TBasicType TUTF8 IO (Ptr (Ptr CString)) desktopAppInfoSearch :: (MonadIO m) => T.Text -> -- search_string m [[T.Text]] desktopAppInfoSearch search_string = liftIO $ do search_string' <- textToCString search_string result <- g_desktop_app_info_search search_string' checkUnexpectedReturnNULL "g_desktop_app_info_search" result result' <- unpackZeroTerminatedPtrArray result result'' <- mapM unpackZeroTerminatedUTF8CArray result' let freeElemOfResult e = mapZeroTerminatedCArray freeMem e >> freeMem e mapZeroTerminatedCArray freeElemOfResult result freeMem result freeMem search_string' return result'' -- method DesktopAppInfo::set_desktop_env -- method type : MemberFunction -- Args : [Arg {argName = "desktop_env", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "desktop_env", 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_desktop_app_info_set_desktop_env" g_desktop_app_info_set_desktop_env :: CString -> -- desktop_env : TBasicType TUTF8 IO () {-# DEPRECATED desktopAppInfoSetDesktopEnv ["(Since version 2.42)","do not use this API. Since 2.42 the value of the","`XDG_CURRENT_DESKTOP` environment variable will be used."]#-} desktopAppInfoSetDesktopEnv :: (MonadIO m) => T.Text -> -- desktop_env m () desktopAppInfoSetDesktopEnv desktop_env = liftIO $ do desktop_env' <- textToCString desktop_env g_desktop_app_info_set_desktop_env desktop_env' freeMem desktop_env' return () -- interface DesktopAppInfoLookup newtype DesktopAppInfoLookup = DesktopAppInfoLookup (ForeignPtr DesktopAppInfoLookup) noDesktopAppInfoLookup :: Maybe DesktopAppInfoLookup noDesktopAppInfoLookup = Nothing foreign import ccall "g_desktop_app_info_lookup_get_type" c_g_desktop_app_info_lookup_get_type :: IO GType type instance ParentTypes DesktopAppInfoLookup = '[GObject.Object] instance GObject DesktopAppInfoLookup where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_desktop_app_info_lookup_get_type class GObject o => DesktopAppInfoLookupK o instance (GObject o, IsDescendantOf DesktopAppInfoLookup o) => DesktopAppInfoLookupK o toDesktopAppInfoLookup :: DesktopAppInfoLookupK o => o -> IO DesktopAppInfoLookup toDesktopAppInfoLookup = unsafeCastTo DesktopAppInfoLookup -- method DesktopAppInfoLookup::get_default_for_uri_scheme -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfoLookup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DesktopAppInfoLookup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "AppInfo" -- throws : False -- Skip return : False foreign import ccall "g_desktop_app_info_lookup_get_default_for_uri_scheme" g_desktop_app_info_lookup_get_default_for_uri_scheme :: Ptr DesktopAppInfoLookup -> -- _obj : TInterface "Gio" "DesktopAppInfoLookup" CString -> -- uri_scheme : TBasicType TUTF8 IO (Ptr AppInfo) {-# DEPRECATED desktopAppInfoLookupGetDefaultForUriScheme ["The #GDesktopAppInfoLookup interface is deprecated and unused by gio."]#-} desktopAppInfoLookupGetDefaultForUriScheme :: (MonadIO m, DesktopAppInfoLookupK a) => a -> -- _obj T.Text -> -- uri_scheme m AppInfo desktopAppInfoLookupGetDefaultForUriScheme _obj uri_scheme = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri_scheme' <- textToCString uri_scheme result <- g_desktop_app_info_lookup_get_default_for_uri_scheme _obj' uri_scheme' checkUnexpectedReturnNULL "g_desktop_app_info_lookup_get_default_for_uri_scheme" result result' <- (wrapObject AppInfo) result touchManagedPtr _obj freeMem uri_scheme' return result' -- callback DesktopAppLaunchCallback desktopAppLaunchCallbackClosure :: DesktopAppLaunchCallback -> IO Closure desktopAppLaunchCallbackClosure cb = newCClosure =<< mkDesktopAppLaunchCallback wrapped where wrapped = desktopAppLaunchCallbackWrapper Nothing cb type DesktopAppLaunchCallbackC = Ptr DesktopAppInfo -> Int32 -> Ptr () -> IO () foreign import ccall "wrapper" mkDesktopAppLaunchCallback :: DesktopAppLaunchCallbackC -> IO (FunPtr DesktopAppLaunchCallbackC) type DesktopAppLaunchCallback = DesktopAppInfo -> Int32 -> IO () noDesktopAppLaunchCallback :: Maybe DesktopAppLaunchCallback noDesktopAppLaunchCallback = Nothing desktopAppLaunchCallbackWrapper :: Maybe (Ptr (FunPtr (DesktopAppLaunchCallbackC))) -> DesktopAppLaunchCallback -> Ptr DesktopAppInfo -> Int32 -> Ptr () -> IO () desktopAppLaunchCallbackWrapper funptrptr _cb appinfo pid _ = do appinfo' <- (newObject DesktopAppInfo) appinfo _cb appinfo' pid maybeReleaseFunPtr funptrptr -- interface Drive newtype Drive = Drive (ForeignPtr Drive) noDrive :: Maybe Drive noDrive = Nothing foreign import ccall "g_drive_get_type" c_g_drive_get_type :: IO GType type instance ParentTypes Drive = '[GObject.Object] instance GObject Drive where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_drive_get_type class GObject o => DriveK o instance (GObject o, IsDescendantOf Drive o) => DriveK o toDrive :: DriveK o => o -> IO Drive toDrive = unsafeCastTo Drive -- method Drive::can_eject -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_can_eject" g_drive_can_eject :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveCanEject :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveCanEject _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_can_eject _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::can_poll_for_media -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_can_poll_for_media" g_drive_can_poll_for_media :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveCanPollForMedia :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveCanPollForMedia _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_can_poll_for_media _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::can_start -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_can_start" g_drive_can_start :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveCanStart :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveCanStart _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_can_start _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::can_start_degraded -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_can_start_degraded" g_drive_can_start_degraded :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveCanStartDegraded :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveCanStartDegraded _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_can_start_degraded _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::can_stop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_can_stop" g_drive_can_stop :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveCanStop :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveCanStop _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_can_stop _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::eject -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_drive_eject" g_drive_eject :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () {-# DEPRECATED driveEject ["(Since version 2.22)","Use g_drive_eject_with_operation() instead."]#-} driveEject :: (MonadIO m, DriveK a, CancellableK b) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () driveEject _obj flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_drive_eject _obj' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Drive::eject_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_drive_eject_finish" g_drive_eject_finish :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt {-# DEPRECATED driveEjectFinish ["(Since version 2.22)","Use g_drive_eject_with_operation_finish() instead."]#-} driveEjectFinish :: (MonadIO m, DriveK a, AsyncResultK b) => a -> -- _obj b -> -- result m () driveEjectFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_drive_eject_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Drive::eject_with_operation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_drive_eject_with_operation" g_drive_eject_with_operation :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () driveEjectWithOperation :: (MonadIO m, DriveK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () driveEjectWithOperation _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_drive_eject_with_operation _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Drive::eject_with_operation_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_drive_eject_with_operation_finish" g_drive_eject_with_operation_finish :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt driveEjectWithOperationFinish :: (MonadIO m, DriveK a, AsyncResultK b) => a -> -- _obj b -> -- result m () driveEjectWithOperationFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_drive_eject_with_operation_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Drive::enumerate_identifiers -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", 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_drive_enumerate_identifiers" g_drive_enumerate_identifiers :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO (Ptr CString) driveEnumerateIdentifiers :: (MonadIO m, DriveK a) => a -> -- _obj m [T.Text] driveEnumerateIdentifiers _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_enumerate_identifiers _obj' checkUnexpectedReturnNULL "g_drive_enumerate_identifiers" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method Drive::get_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_drive_get_icon" g_drive_get_icon :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO (Ptr Icon) driveGetIcon :: (MonadIO m, DriveK a) => a -> -- _obj m Icon driveGetIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_get_icon _obj' checkUnexpectedReturnNULL "g_drive_get_icon" result result' <- (wrapObject Icon) result touchManagedPtr _obj return result' -- method Drive::get_identifier -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "kind", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "kind", 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_drive_get_identifier" g_drive_get_identifier :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" CString -> -- kind : TBasicType TUTF8 IO CString driveGetIdentifier :: (MonadIO m, DriveK a) => a -> -- _obj T.Text -> -- kind m T.Text driveGetIdentifier _obj kind = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj kind' <- textToCString kind result <- g_drive_get_identifier _obj' kind' checkUnexpectedReturnNULL "g_drive_get_identifier" result result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem kind' return result' -- method Drive::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_drive_get_name" g_drive_get_name :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CString driveGetName :: (MonadIO m, DriveK a) => a -> -- _obj m T.Text driveGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_get_name _obj' checkUnexpectedReturnNULL "g_drive_get_name" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method Drive::get_sort_key -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_drive_get_sort_key" g_drive_get_sort_key :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CString driveGetSortKey :: (MonadIO m, DriveK a) => a -> -- _obj m T.Text driveGetSortKey _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_get_sort_key _obj' checkUnexpectedReturnNULL "g_drive_get_sort_key" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Drive::get_start_stop_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DriveStartStopType" -- throws : False -- Skip return : False foreign import ccall "g_drive_get_start_stop_type" g_drive_get_start_stop_type :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CUInt driveGetStartStopType :: (MonadIO m, DriveK a) => a -> -- _obj m DriveStartStopType driveGetStartStopType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_get_start_stop_type _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Drive::get_symbolic_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_drive_get_symbolic_icon" g_drive_get_symbolic_icon :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO (Ptr Icon) driveGetSymbolicIcon :: (MonadIO m, DriveK a) => a -> -- _obj m Icon driveGetSymbolicIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_get_symbolic_icon _obj' checkUnexpectedReturnNULL "g_drive_get_symbolic_icon" result result' <- (wrapObject Icon) result touchManagedPtr _obj return result' -- method Drive::get_volumes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "Volume") -- throws : False -- Skip return : False foreign import ccall "g_drive_get_volumes" g_drive_get_volumes :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO (Ptr (GList (Ptr Volume))) driveGetVolumes :: (MonadIO m, DriveK a) => a -> -- _obj m [Volume] driveGetVolumes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_get_volumes _obj' checkUnexpectedReturnNULL "g_drive_get_volumes" result result' <- unpackGList result result'' <- mapM (wrapObject Volume) result' g_list_free result touchManagedPtr _obj return result'' -- method Drive::has_media -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_has_media" g_drive_has_media :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveHasMedia :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveHasMedia _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_has_media _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::has_volumes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_has_volumes" g_drive_has_volumes :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveHasVolumes :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveHasVolumes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_has_volumes _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::is_media_check_automatic -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_is_media_check_automatic" g_drive_is_media_check_automatic :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveIsMediaCheckAutomatic :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveIsMediaCheckAutomatic _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_is_media_check_automatic _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::is_media_removable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_drive_is_media_removable" g_drive_is_media_removable :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" IO CInt driveIsMediaRemovable :: (MonadIO m, DriveK a) => a -> -- _obj m Bool driveIsMediaRemovable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_drive_is_media_removable _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Drive::poll_for_media -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_drive_poll_for_media" g_drive_poll_for_media :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () drivePollForMedia :: (MonadIO m, DriveK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () drivePollForMedia _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_drive_poll_for_media _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Drive::poll_for_media_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_drive_poll_for_media_finish" g_drive_poll_for_media_finish :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt drivePollForMediaFinish :: (MonadIO m, DriveK a, AsyncResultK b) => a -> -- _obj b -> -- result m () drivePollForMediaFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_drive_poll_for_media_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Drive::start -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DriveStartFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DriveStartFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_drive_start" g_drive_start :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" CUInt -> -- flags : TInterface "Gio" "DriveStartFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () driveStart :: (MonadIO m, DriveK a, MountOperationK b, CancellableK c) => a -> -- _obj [DriveStartFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () driveStart _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_drive_start _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Drive::start_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_drive_start_finish" g_drive_start_finish :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt driveStartFinish :: (MonadIO m, DriveK a, AsyncResultK b) => a -> -- _obj b -> -- result m () driveStartFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_drive_start_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Drive::stop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_drive_stop" g_drive_stop :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () driveStop :: (MonadIO m, DriveK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () driveStop _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_drive_stop _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Drive::stop_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Drive", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_drive_stop_finish" g_drive_stop_finish :: Ptr Drive -> -- _obj : TInterface "Gio" "Drive" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt driveStopFinish :: (MonadIO m, DriveK a, AsyncResultK b) => a -> -- _obj b -> -- result m () driveStopFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_drive_stop_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- signal Drive::changed type DriveChangedCallback = IO () noDriveChangedCallback :: Maybe DriveChangedCallback noDriveChangedCallback = Nothing type DriveChangedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDriveChangedCallback :: DriveChangedCallbackC -> IO (FunPtr DriveChangedCallbackC) driveChangedClosure :: DriveChangedCallback -> IO Closure driveChangedClosure cb = newCClosure =<< mkDriveChangedCallback wrapped where wrapped = driveChangedCallbackWrapper cb driveChangedCallbackWrapper :: DriveChangedCallback -> Ptr () -> Ptr () -> IO () driveChangedCallbackWrapper _cb _ _ = do _cb onDriveChanged :: (GObject a, MonadIO m) => a -> DriveChangedCallback -> m SignalHandlerId onDriveChanged obj cb = liftIO $ connectDriveChanged obj cb SignalConnectBefore afterDriveChanged :: (GObject a, MonadIO m) => a -> DriveChangedCallback -> m SignalHandlerId afterDriveChanged obj cb = connectDriveChanged obj cb SignalConnectAfter connectDriveChanged :: (GObject a, MonadIO m) => a -> DriveChangedCallback -> SignalConnectMode -> m SignalHandlerId connectDriveChanged obj cb after = liftIO $ do cb' <- mkDriveChangedCallback (driveChangedCallbackWrapper cb) connectSignalFunPtr obj "changed" cb' after -- signal Drive::disconnected type DriveDisconnectedCallback = IO () noDriveDisconnectedCallback :: Maybe DriveDisconnectedCallback noDriveDisconnectedCallback = Nothing type DriveDisconnectedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDriveDisconnectedCallback :: DriveDisconnectedCallbackC -> IO (FunPtr DriveDisconnectedCallbackC) driveDisconnectedClosure :: DriveDisconnectedCallback -> IO Closure driveDisconnectedClosure cb = newCClosure =<< mkDriveDisconnectedCallback wrapped where wrapped = driveDisconnectedCallbackWrapper cb driveDisconnectedCallbackWrapper :: DriveDisconnectedCallback -> Ptr () -> Ptr () -> IO () driveDisconnectedCallbackWrapper _cb _ _ = do _cb onDriveDisconnected :: (GObject a, MonadIO m) => a -> DriveDisconnectedCallback -> m SignalHandlerId onDriveDisconnected obj cb = liftIO $ connectDriveDisconnected obj cb SignalConnectBefore afterDriveDisconnected :: (GObject a, MonadIO m) => a -> DriveDisconnectedCallback -> m SignalHandlerId afterDriveDisconnected obj cb = connectDriveDisconnected obj cb SignalConnectAfter connectDriveDisconnected :: (GObject a, MonadIO m) => a -> DriveDisconnectedCallback -> SignalConnectMode -> m SignalHandlerId connectDriveDisconnected obj cb after = liftIO $ do cb' <- mkDriveDisconnectedCallback (driveDisconnectedCallbackWrapper cb) connectSignalFunPtr obj "disconnected" cb' after -- signal Drive::eject-button type DriveEjectButtonCallback = IO () noDriveEjectButtonCallback :: Maybe DriveEjectButtonCallback noDriveEjectButtonCallback = Nothing type DriveEjectButtonCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDriveEjectButtonCallback :: DriveEjectButtonCallbackC -> IO (FunPtr DriveEjectButtonCallbackC) driveEjectButtonClosure :: DriveEjectButtonCallback -> IO Closure driveEjectButtonClosure cb = newCClosure =<< mkDriveEjectButtonCallback wrapped where wrapped = driveEjectButtonCallbackWrapper cb driveEjectButtonCallbackWrapper :: DriveEjectButtonCallback -> Ptr () -> Ptr () -> IO () driveEjectButtonCallbackWrapper _cb _ _ = do _cb onDriveEjectButton :: (GObject a, MonadIO m) => a -> DriveEjectButtonCallback -> m SignalHandlerId onDriveEjectButton obj cb = liftIO $ connectDriveEjectButton obj cb SignalConnectBefore afterDriveEjectButton :: (GObject a, MonadIO m) => a -> DriveEjectButtonCallback -> m SignalHandlerId afterDriveEjectButton obj cb = connectDriveEjectButton obj cb SignalConnectAfter connectDriveEjectButton :: (GObject a, MonadIO m) => a -> DriveEjectButtonCallback -> SignalConnectMode -> m SignalHandlerId connectDriveEjectButton obj cb after = liftIO $ do cb' <- mkDriveEjectButtonCallback (driveEjectButtonCallbackWrapper cb) connectSignalFunPtr obj "eject-button" cb' after -- signal Drive::stop-button type DriveStopButtonCallback = IO () noDriveStopButtonCallback :: Maybe DriveStopButtonCallback noDriveStopButtonCallback = Nothing type DriveStopButtonCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkDriveStopButtonCallback :: DriveStopButtonCallbackC -> IO (FunPtr DriveStopButtonCallbackC) driveStopButtonClosure :: DriveStopButtonCallback -> IO Closure driveStopButtonClosure cb = newCClosure =<< mkDriveStopButtonCallback wrapped where wrapped = driveStopButtonCallbackWrapper cb driveStopButtonCallbackWrapper :: DriveStopButtonCallback -> Ptr () -> Ptr () -> IO () driveStopButtonCallbackWrapper _cb _ _ = do _cb onDriveStopButton :: (GObject a, MonadIO m) => a -> DriveStopButtonCallback -> m SignalHandlerId onDriveStopButton obj cb = liftIO $ connectDriveStopButton obj cb SignalConnectBefore afterDriveStopButton :: (GObject a, MonadIO m) => a -> DriveStopButtonCallback -> m SignalHandlerId afterDriveStopButton obj cb = connectDriveStopButton obj cb SignalConnectAfter connectDriveStopButton :: (GObject a, MonadIO m) => a -> DriveStopButtonCallback -> SignalConnectMode -> m SignalHandlerId connectDriveStopButton obj cb after = liftIO $ do cb' <- mkDriveStopButtonCallback (driveStopButtonCallbackWrapper cb) connectSignalFunPtr obj "stop-button" cb' after -- Flags DriveStartFlags data DriveStartFlags = DriveStartFlagsNone | AnotherDriveStartFlags Int deriving (Show, Eq) instance Enum DriveStartFlags where fromEnum DriveStartFlagsNone = 0 fromEnum (AnotherDriveStartFlags k) = k toEnum 0 = DriveStartFlagsNone toEnum k = AnotherDriveStartFlags k foreign import ccall "g_drive_start_flags_get_type" c_g_drive_start_flags_get_type :: IO GType instance BoxedEnum DriveStartFlags where boxedEnumType _ = c_g_drive_start_flags_get_type instance IsGFlag DriveStartFlags -- Enum DriveStartStopType data DriveStartStopType = DriveStartStopTypeUnknown | DriveStartStopTypeShutdown | DriveStartStopTypeNetwork | DriveStartStopTypeMultidisk | DriveStartStopTypePassword | AnotherDriveStartStopType Int deriving (Show, Eq) instance Enum DriveStartStopType where fromEnum DriveStartStopTypeUnknown = 0 fromEnum DriveStartStopTypeShutdown = 1 fromEnum DriveStartStopTypeNetwork = 2 fromEnum DriveStartStopTypeMultidisk = 3 fromEnum DriveStartStopTypePassword = 4 fromEnum (AnotherDriveStartStopType k) = k toEnum 0 = DriveStartStopTypeUnknown toEnum 1 = DriveStartStopTypeShutdown toEnum 2 = DriveStartStopTypeNetwork toEnum 3 = DriveStartStopTypeMultidisk toEnum 4 = DriveStartStopTypePassword toEnum k = AnotherDriveStartStopType k foreign import ccall "g_drive_start_stop_type_get_type" c_g_drive_start_stop_type_get_type :: IO GType instance BoxedEnum DriveStartStopType where boxedEnumType _ = c_g_drive_start_stop_type_get_type -- object Emblem newtype Emblem = Emblem (ForeignPtr Emblem) noEmblem :: Maybe Emblem noEmblem = Nothing foreign import ccall "g_emblem_get_type" c_g_emblem_get_type :: IO GType type instance ParentTypes Emblem = '[GObject.Object, Icon] instance GObject Emblem where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_emblem_get_type class GObject o => EmblemK o instance (GObject o, IsDescendantOf Emblem o) => EmblemK o toEmblem :: EmblemK o => o -> IO Emblem toEmblem = unsafeCastTo Emblem -- method Emblem::new -- method type : Constructor -- Args : [Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Emblem" -- throws : False -- Skip return : False foreign import ccall "g_emblem_new" g_emblem_new :: Ptr Icon -> -- icon : TInterface "Gio" "Icon" IO (Ptr Emblem) emblemNew :: (MonadIO m, IconK a) => a -> -- icon m Emblem emblemNew icon = liftIO $ do let icon' = unsafeManagedPtrCastPtr icon result <- g_emblem_new icon' checkUnexpectedReturnNULL "g_emblem_new" result result' <- (wrapObject Emblem) result touchManagedPtr icon return result' -- method Emblem::new_with_origin -- method type : Constructor -- Args : [Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "origin", argType = TInterface "Gio" "EmblemOrigin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "origin", argType = TInterface "Gio" "EmblemOrigin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Emblem" -- throws : False -- Skip return : False foreign import ccall "g_emblem_new_with_origin" g_emblem_new_with_origin :: Ptr Icon -> -- icon : TInterface "Gio" "Icon" CUInt -> -- origin : TInterface "Gio" "EmblemOrigin" IO (Ptr Emblem) emblemNewWithOrigin :: (MonadIO m, IconK a) => a -> -- icon EmblemOrigin -> -- origin m Emblem emblemNewWithOrigin icon origin = liftIO $ do let icon' = unsafeManagedPtrCastPtr icon let origin' = (fromIntegral . fromEnum) origin result <- g_emblem_new_with_origin icon' origin' checkUnexpectedReturnNULL "g_emblem_new_with_origin" result result' <- (wrapObject Emblem) result touchManagedPtr icon return result' -- method Emblem::get_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Emblem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Emblem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_emblem_get_icon" g_emblem_get_icon :: Ptr Emblem -> -- _obj : TInterface "Gio" "Emblem" IO (Ptr Icon) emblemGetIcon :: (MonadIO m, EmblemK a) => a -> -- _obj m Icon emblemGetIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_emblem_get_icon _obj' checkUnexpectedReturnNULL "g_emblem_get_icon" result result' <- (newObject Icon) result touchManagedPtr _obj return result' -- method Emblem::get_origin -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Emblem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Emblem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "EmblemOrigin" -- throws : False -- Skip return : False foreign import ccall "g_emblem_get_origin" g_emblem_get_origin :: Ptr Emblem -> -- _obj : TInterface "Gio" "Emblem" IO CUInt emblemGetOrigin :: (MonadIO m, EmblemK a) => a -> -- _obj m EmblemOrigin emblemGetOrigin _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_emblem_get_origin _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- Enum EmblemOrigin data EmblemOrigin = EmblemOriginUnknown | EmblemOriginDevice | EmblemOriginLivemetadata | EmblemOriginTag | AnotherEmblemOrigin Int deriving (Show, Eq) instance Enum EmblemOrigin where fromEnum EmblemOriginUnknown = 0 fromEnum EmblemOriginDevice = 1 fromEnum EmblemOriginLivemetadata = 2 fromEnum EmblemOriginTag = 3 fromEnum (AnotherEmblemOrigin k) = k toEnum 0 = EmblemOriginUnknown toEnum 1 = EmblemOriginDevice toEnum 2 = EmblemOriginLivemetadata toEnum 3 = EmblemOriginTag toEnum k = AnotherEmblemOrigin k foreign import ccall "g_emblem_origin_get_type" c_g_emblem_origin_get_type :: IO GType instance BoxedEnum EmblemOrigin where boxedEnumType _ = c_g_emblem_origin_get_type -- object EmblemedIcon newtype EmblemedIcon = EmblemedIcon (ForeignPtr EmblemedIcon) noEmblemedIcon :: Maybe EmblemedIcon noEmblemedIcon = Nothing foreign import ccall "g_emblemed_icon_get_type" c_g_emblemed_icon_get_type :: IO GType type instance ParentTypes EmblemedIcon = '[GObject.Object, Icon] instance GObject EmblemedIcon where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_emblemed_icon_get_type class GObject o => EmblemedIconK o instance (GObject o, IsDescendantOf EmblemedIcon o) => EmblemedIconK o toEmblemedIcon :: EmblemedIconK o => o -> IO EmblemedIcon toEmblemedIcon = unsafeCastTo EmblemedIcon -- method EmblemedIcon::new -- method type : Constructor -- Args : [Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "emblem", argType = TInterface "Gio" "Emblem", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "emblem", argType = TInterface "Gio" "Emblem", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "EmblemedIcon" -- throws : False -- Skip return : False foreign import ccall "g_emblemed_icon_new" g_emblemed_icon_new :: Ptr Icon -> -- icon : TInterface "Gio" "Icon" Ptr Emblem -> -- emblem : TInterface "Gio" "Emblem" IO (Ptr EmblemedIcon) emblemedIconNew :: (MonadIO m, IconK a, EmblemK b) => a -> -- icon Maybe (b) -> -- emblem m EmblemedIcon emblemedIconNew icon emblem = liftIO $ do let icon' = unsafeManagedPtrCastPtr icon maybeEmblem <- case emblem of Nothing -> return nullPtr Just jEmblem -> do let jEmblem' = unsafeManagedPtrCastPtr jEmblem return jEmblem' result <- g_emblemed_icon_new icon' maybeEmblem checkUnexpectedReturnNULL "g_emblemed_icon_new" result result' <- (wrapObject EmblemedIcon) result touchManagedPtr icon whenJust emblem touchManagedPtr return result' -- method EmblemedIcon::add_emblem -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "EmblemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "emblem", argType = TInterface "Gio" "Emblem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "EmblemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "emblem", argType = TInterface "Gio" "Emblem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_emblemed_icon_add_emblem" g_emblemed_icon_add_emblem :: Ptr EmblemedIcon -> -- _obj : TInterface "Gio" "EmblemedIcon" Ptr Emblem -> -- emblem : TInterface "Gio" "Emblem" IO () emblemedIconAddEmblem :: (MonadIO m, EmblemedIconK a, EmblemK b) => a -> -- _obj b -> -- emblem m () emblemedIconAddEmblem _obj emblem = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let emblem' = unsafeManagedPtrCastPtr emblem g_emblemed_icon_add_emblem _obj' emblem' touchManagedPtr _obj touchManagedPtr emblem return () -- method EmblemedIcon::clear_emblems -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "EmblemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "EmblemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_emblemed_icon_clear_emblems" g_emblemed_icon_clear_emblems :: Ptr EmblemedIcon -> -- _obj : TInterface "Gio" "EmblemedIcon" IO () emblemedIconClearEmblems :: (MonadIO m, EmblemedIconK a) => a -> -- _obj m () emblemedIconClearEmblems _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_emblemed_icon_clear_emblems _obj' touchManagedPtr _obj return () -- method EmblemedIcon::get_emblems -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "EmblemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "EmblemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "Emblem") -- throws : False -- Skip return : False foreign import ccall "g_emblemed_icon_get_emblems" g_emblemed_icon_get_emblems :: Ptr EmblemedIcon -> -- _obj : TInterface "Gio" "EmblemedIcon" IO (Ptr (GList (Ptr Emblem))) emblemedIconGetEmblems :: (MonadIO m, EmblemedIconK a) => a -> -- _obj m [Emblem] emblemedIconGetEmblems _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_emblemed_icon_get_emblems _obj' checkUnexpectedReturnNULL "g_emblemed_icon_get_emblems" result result' <- unpackGList result result'' <- mapM (newObject Emblem) result' touchManagedPtr _obj return result'' -- method EmblemedIcon::get_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "EmblemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "EmblemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_emblemed_icon_get_icon" g_emblemed_icon_get_icon :: Ptr EmblemedIcon -> -- _obj : TInterface "Gio" "EmblemedIcon" IO (Ptr Icon) emblemedIconGetIcon :: (MonadIO m, EmblemedIconK a) => a -> -- _obj m Icon emblemedIconGetIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_emblemed_icon_get_icon _obj' checkUnexpectedReturnNULL "g_emblemed_icon_get_icon" result result' <- (newObject Icon) result touchManagedPtr _obj return result' -- interface File newtype File = File (ForeignPtr File) noFile :: Maybe File noFile = Nothing foreign import ccall "g_file_get_type" c_g_file_get_type :: IO GType type instance ParentTypes File = '[GObject.Object] instance GObject File where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_get_type class GObject o => FileK o instance (GObject o, IsDescendantOf File o) => FileK o toFile :: FileK o => o -> IO File toFile = unsafeCastTo File -- method File::append_to -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileOutputStream" -- throws : True -- Skip return : False foreign import ccall "g_file_append_to" g_file_append_to :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileOutputStream) fileAppendTo :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileCreateFlags] -> -- flags Maybe (b) -> -- cancellable m FileOutputStream fileAppendTo _obj flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_append_to _obj' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_append_to" result result' <- (wrapObject FileOutputStream) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::append_to_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_append_to_async" g_file_append_to_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileAppendToAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileCreateFlags] -> -- flags Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileAppendToAsync _obj flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_append_to_async _obj' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::append_to_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileOutputStream" -- throws : True -- Skip return : False foreign import ccall "g_file_append_to_finish" g_file_append_to_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileOutputStream) fileAppendToFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileOutputStream fileAppendToFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_append_to_finish _obj' res' checkUnexpectedReturnNULL "g_file_append_to_finish" result result' <- (wrapObject FileOutputStream) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destination", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCopyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "progress_callback", argType = TInterface "Gio" "FileProgressCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 5, argDestroy = -1, transfer = TransferNothing},Arg {argName = "progress_callback_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destination", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCopyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "progress_callback", argType = TInterface "Gio" "FileProgressCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_copy" g_file_copy :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr File -> -- destination : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCopyFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr FileProgressCallbackC -> -- progress_callback : TInterface "Gio" "FileProgressCallback" Ptr () -> -- progress_callback_data : TBasicType TVoid Ptr (Ptr GError) -> -- error IO CInt fileCopy :: (MonadIO m, FileK a, FileK b, CancellableK c) => a -> -- _obj b -> -- destination [FileCopyFlags] -> -- flags Maybe (c) -> -- cancellable Maybe (FileProgressCallback) -> -- progress_callback m () fileCopy _obj destination flags cancellable progress_callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let destination' = unsafeManagedPtrCastPtr destination let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' maybeProgress_callback <- case progress_callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jProgress_callback -> do jProgress_callback' <- mkFileProgressCallback (fileProgressCallbackWrapper Nothing jProgress_callback) return jProgress_callback' let progress_callback_data = nullPtr onException (do _ <- propagateGError $ g_file_copy _obj' destination' flags' maybeCancellable maybeProgress_callback progress_callback_data safeFreeFunPtr $ castFunPtrToPtr maybeProgress_callback touchManagedPtr _obj touchManagedPtr destination whenJust cancellable touchManagedPtr return () ) (do safeFreeFunPtr $ castFunPtrToPtr maybeProgress_callback return () ) -- method File::copy_attributes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destination", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCopyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destination", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCopyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_copy_attributes" g_file_copy_attributes :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr File -> -- destination : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCopyFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileCopyAttributes :: (MonadIO m, FileK a, FileK b, CancellableK c) => a -> -- _obj b -> -- destination [FileCopyFlags] -> -- flags Maybe (c) -> -- cancellable m () fileCopyAttributes _obj destination flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let destination' = unsafeManagedPtrCastPtr destination let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_copy_attributes _obj' destination' flags' maybeCancellable touchManagedPtr _obj touchManagedPtr destination whenJust cancellable touchManagedPtr return () ) (do return () ) -- method File::copy_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", 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_copy_finish" g_file_copy_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileCopyFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m () fileCopyFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do _ <- propagateGError $ g_file_copy_finish _obj' res' touchManagedPtr _obj touchManagedPtr res return () ) (do return () ) -- method File::create -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileOutputStream" -- throws : True -- Skip return : False foreign import ccall "g_file_create" g_file_create :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileOutputStream) fileCreate :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileCreateFlags] -> -- flags Maybe (b) -> -- cancellable m FileOutputStream fileCreate _obj flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_create _obj' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_create" result result' <- (wrapObject FileOutputStream) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::create_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_create_async" g_file_create_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileCreateAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileCreateFlags] -> -- flags Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileCreateAsync _obj flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_create_async _obj' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::create_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileOutputStream" -- throws : True -- Skip return : False foreign import ccall "g_file_create_finish" g_file_create_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileOutputStream) fileCreateFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileOutputStream fileCreateFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_create_finish _obj' res' checkUnexpectedReturnNULL "g_file_create_finish" result result' <- (wrapObject FileOutputStream) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::create_readwrite -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileIOStream" -- throws : True -- Skip return : False foreign import ccall "g_file_create_readwrite" g_file_create_readwrite :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileIOStream) fileCreateReadwrite :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileCreateFlags] -> -- flags Maybe (b) -> -- cancellable m FileIOStream fileCreateReadwrite _obj flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_create_readwrite _obj' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_create_readwrite" result result' <- (wrapObject FileIOStream) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::create_readwrite_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_create_readwrite_async" g_file_create_readwrite_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileCreateReadwriteAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileCreateFlags] -> -- flags Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileCreateReadwriteAsync _obj flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_create_readwrite_async _obj' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::create_readwrite_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileIOStream" -- throws : True -- Skip return : False foreign import ccall "g_file_create_readwrite_finish" g_file_create_readwrite_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileIOStream) fileCreateReadwriteFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileIOStream fileCreateReadwriteFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_create_readwrite_finish _obj' res' checkUnexpectedReturnNULL "g_file_create_readwrite_finish" result result' <- (wrapObject FileIOStream) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::delete -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_delete" g_file_delete :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileDelete :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () fileDelete _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_delete _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method File::delete_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_delete_async" g_file_delete_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileDeleteAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileDeleteAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_delete_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::delete_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_delete_finish" g_file_delete_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileDeleteFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileDeleteFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_delete_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::dup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_dup" g_file_dup :: Ptr File -> -- _obj : TInterface "Gio" "File" IO (Ptr File) fileDup :: (MonadIO m, FileK a) => a -> -- _obj m File fileDup _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_dup _obj' checkUnexpectedReturnNULL "g_file_dup" result result' <- (wrapObject File) result touchManagedPtr _obj return result' -- method File::eject_mountable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_eject_mountable" g_file_eject_mountable :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () {-# DEPRECATED fileEjectMountable ["(Since version 2.22)","Use g_file_eject_mountable_with_operation() instead."]#-} fileEjectMountable :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileEjectMountable _obj flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_eject_mountable _obj' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::eject_mountable_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_eject_mountable_finish" g_file_eject_mountable_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt {-# DEPRECATED fileEjectMountableFinish ["(Since version 2.22)","Use g_file_eject_mountable_with_operation_finish()"," instead."]#-} fileEjectMountableFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileEjectMountableFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_eject_mountable_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::eject_mountable_with_operation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_eject_mountable_with_operation" g_file_eject_mountable_with_operation :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileEjectMountableWithOperation :: (MonadIO m, FileK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileEjectMountableWithOperation _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_eject_mountable_with_operation _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method File::eject_mountable_with_operation_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_eject_mountable_with_operation_finish" g_file_eject_mountable_with_operation_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileEjectMountableWithOperationFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileEjectMountableWithOperationFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_eject_mountable_with_operation_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::enumerate_children -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileEnumerator" -- throws : True -- Skip return : False foreign import ccall "g_file_enumerate_children" g_file_enumerate_children :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attributes : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileEnumerator) fileEnumerateChildren :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m FileEnumerator fileEnumerateChildren _obj attributes flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_enumerate_children _obj' attributes' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_enumerate_children" result result' <- (wrapObject FileEnumerator) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return result' ) (do freeMem attributes' ) -- method File::enumerate_children_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_enumerate_children_async" g_file_enumerate_children_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attributes : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileEnumerateChildrenAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes [FileQueryInfoFlags] -> -- flags Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileEnumerateChildrenAsync _obj attributes flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_enumerate_children_async _obj' attributes' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return () -- method File::enumerate_children_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileEnumerator" -- throws : True -- Skip return : False foreign import ccall "g_file_enumerate_children_finish" g_file_enumerate_children_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileEnumerator) fileEnumerateChildrenFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileEnumerator fileEnumerateChildrenFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_enumerate_children_finish _obj' res' checkUnexpectedReturnNULL "g_file_enumerate_children_finish" result result' <- (wrapObject FileEnumerator) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file2", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file2", argType = TInterface "Gio" "File", 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_equal" g_file_equal :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr File -> -- file2 : TInterface "Gio" "File" IO CInt fileEqual :: (MonadIO m, FileK a, FileK b) => a -> -- _obj b -> -- file2 m Bool fileEqual _obj file2 = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let file2' = unsafeManagedPtrCastPtr file2 result <- g_file_equal _obj' file2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr file2 return result' -- method File::find_enclosing_mount -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Mount" -- throws : True -- Skip return : False foreign import ccall "g_file_find_enclosing_mount" g_file_find_enclosing_mount :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr Mount) fileFindEnclosingMount :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Mount fileFindEnclosingMount _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_find_enclosing_mount _obj' maybeCancellable checkUnexpectedReturnNULL "g_file_find_enclosing_mount" result result' <- (wrapObject Mount) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::find_enclosing_mount_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_find_enclosing_mount_async" g_file_find_enclosing_mount_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileFindEnclosingMountAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileFindEnclosingMountAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_find_enclosing_mount_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::find_enclosing_mount_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Mount" -- throws : True -- Skip return : False foreign import ccall "g_file_find_enclosing_mount_finish" g_file_find_enclosing_mount_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr Mount) fileFindEnclosingMountFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m Mount fileFindEnclosingMountFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_find_enclosing_mount_finish _obj' res' checkUnexpectedReturnNULL "g_file_find_enclosing_mount_finish" result result' <- (wrapObject Mount) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::get_basename -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_get_basename" g_file_get_basename :: Ptr File -> -- _obj : TInterface "Gio" "File" IO CString fileGetBasename :: (MonadIO m, FileK a) => a -> -- _obj m T.Text fileGetBasename _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_get_basename _obj' checkUnexpectedReturnNULL "g_file_get_basename" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method File::get_child -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", 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 "Gio" "File", 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 : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_get_child" g_file_get_child :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- name : TBasicType TUTF8 IO (Ptr File) fileGetChild :: (MonadIO m, FileK a) => a -> -- _obj T.Text -> -- name m File fileGetChild _obj name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- textToCString name result <- g_file_get_child _obj' name' checkUnexpectedReturnNULL "g_file_get_child" result result' <- (wrapObject File) result touchManagedPtr _obj freeMem name' return result' -- method File::get_child_for_display_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "display_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "display_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : True -- Skip return : False foreign import ccall "g_file_get_child_for_display_name" g_file_get_child_for_display_name :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- display_name : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr File) fileGetChildForDisplayName :: (MonadIO m, FileK a) => a -> -- _obj T.Text -> -- display_name m File fileGetChildForDisplayName _obj display_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj display_name' <- textToCString display_name onException (do result <- propagateGError $ g_file_get_child_for_display_name _obj' display_name' checkUnexpectedReturnNULL "g_file_get_child_for_display_name" result result' <- (wrapObject File) result touchManagedPtr _obj freeMem display_name' return result' ) (do freeMem display_name' ) -- method File::get_parent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_get_parent" g_file_get_parent :: Ptr File -> -- _obj : TInterface "Gio" "File" IO (Ptr File) fileGetParent :: (MonadIO m, FileK a) => a -> -- _obj m File fileGetParent _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_get_parent _obj' checkUnexpectedReturnNULL "g_file_get_parent" result result' <- (wrapObject File) result touchManagedPtr _obj return result' -- method File::get_parse_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_get_parse_name" g_file_get_parse_name :: Ptr File -> -- _obj : TInterface "Gio" "File" IO CString fileGetParseName :: (MonadIO m, FileK a) => a -> -- _obj m T.Text fileGetParseName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_get_parse_name _obj' checkUnexpectedReturnNULL "g_file_get_parse_name" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method File::get_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_get_path" g_file_get_path :: Ptr File -> -- _obj : TInterface "Gio" "File" IO CString fileGetPath :: (MonadIO m, FileK a) => a -> -- _obj m T.Text fileGetPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_get_path _obj' checkUnexpectedReturnNULL "g_file_get_path" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method File::get_relative_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "descendant", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "descendant", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_get_relative_path" g_file_get_relative_path :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr File -> -- descendant : TInterface "Gio" "File" IO CString fileGetRelativePath :: (MonadIO m, FileK a, FileK b) => a -> -- _obj b -> -- descendant m T.Text fileGetRelativePath _obj descendant = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let descendant' = unsafeManagedPtrCastPtr descendant result <- g_file_get_relative_path _obj' descendant' checkUnexpectedReturnNULL "g_file_get_relative_path" result result' <- cstringToText result freeMem result touchManagedPtr _obj touchManagedPtr descendant return result' -- method File::get_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_get_uri" g_file_get_uri :: Ptr File -> -- _obj : TInterface "Gio" "File" IO CString fileGetUri :: (MonadIO m, FileK a) => a -> -- _obj m T.Text fileGetUri _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_get_uri _obj' checkUnexpectedReturnNULL "g_file_get_uri" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method File::get_uri_scheme -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_get_uri_scheme" g_file_get_uri_scheme :: Ptr File -> -- _obj : TInterface "Gio" "File" IO CString fileGetUriScheme :: (MonadIO m, FileK a) => a -> -- _obj m T.Text fileGetUriScheme _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_get_uri_scheme _obj' checkUnexpectedReturnNULL "g_file_get_uri_scheme" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method File::has_parent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_file_has_parent" g_file_has_parent :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr File -> -- parent : TInterface "Gio" "File" IO CInt fileHasParent :: (MonadIO m, FileK a, FileK b) => a -> -- _obj Maybe (b) -> -- parent m Bool fileHasParent _obj parent = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeParent <- case parent of Nothing -> return nullPtr Just jParent -> do let jParent' = unsafeManagedPtrCastPtr jParent return jParent' result <- g_file_has_parent _obj' maybeParent let result' = (/= 0) result touchManagedPtr _obj whenJust parent touchManagedPtr return result' -- method File::has_prefix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "prefix", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "prefix", argType = TInterface "Gio" "File", 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_has_prefix" g_file_has_prefix :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr File -> -- prefix : TInterface "Gio" "File" IO CInt fileHasPrefix :: (MonadIO m, FileK a, FileK b) => a -> -- _obj b -> -- prefix m Bool fileHasPrefix _obj prefix = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let prefix' = unsafeManagedPtrCastPtr prefix result <- g_file_has_prefix _obj' prefix' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr prefix return result' -- method File::has_uri_scheme -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_scheme", 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_file_has_uri_scheme" g_file_has_uri_scheme :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- uri_scheme : TBasicType TUTF8 IO CInt fileHasUriScheme :: (MonadIO m, FileK a) => a -> -- _obj T.Text -> -- uri_scheme m Bool fileHasUriScheme _obj uri_scheme = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri_scheme' <- textToCString uri_scheme result <- g_file_has_uri_scheme _obj' uri_scheme' let result' = (/= 0) result touchManagedPtr _obj freeMem uri_scheme' return result' -- method File::hash -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_file_hash" g_file_hash :: Ptr File -> -- _obj : TInterface "Gio" "File" IO Word32 fileHash :: (MonadIO m, FileK a) => a -> -- _obj m Word32 fileHash _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_hash _obj' touchManagedPtr _obj return result -- method File::is_native -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", 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_is_native" g_file_is_native :: Ptr File -> -- _obj : TInterface "Gio" "File" IO CInt fileIsNative :: (MonadIO m, FileK a) => a -> -- _obj m Bool fileIsNative _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_is_native _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method File::load_contents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "contents", argType = TCArray False (-1) 3 (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},Arg {argName = "etag_out", argType = TBasicType TUTF8, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_load_contents" g_file_load_contents :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr Word8) -> -- contents : TCArray False (-1) 3 (TBasicType TUInt8) Ptr Word64 -> -- length : TBasicType TUInt64 Ptr CString -> -- etag_out : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt fileLoadContents :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m (ByteString,T.Text) fileLoadContents _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' contents <- allocMem :: IO (Ptr (Ptr Word8)) length_ <- allocMem :: IO (Ptr Word64) etag_out <- allocMem :: IO (Ptr CString) onException (do _ <- propagateGError $ g_file_load_contents _obj' maybeCancellable contents length_ etag_out length_' <- peek length_ contents' <- peek contents contents'' <- (unpackByteStringWithLength length_') contents' freeMem contents' etag_out' <- peek etag_out etag_out'' <- cstringToText etag_out' freeMem etag_out' touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem contents freeMem length_ freeMem etag_out return (contents'', etag_out'') ) (do freeMem contents freeMem length_ freeMem etag_out ) -- method File::load_contents_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_load_contents_async" g_file_load_contents_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileLoadContentsAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileLoadContentsAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_load_contents_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::load_contents_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "contents", argType = TCArray False (-1) 3 (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},Arg {argName = "etag_out", argType = TBasicType TUTF8, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", 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_load_contents_finish" g_file_load_contents_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr Word8) -> -- contents : TCArray False (-1) 3 (TBasicType TUInt8) Ptr Word64 -> -- length : TBasicType TUInt64 Ptr CString -> -- etag_out : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt fileLoadContentsFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m (ByteString,T.Text) fileLoadContentsFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res contents <- allocMem :: IO (Ptr (Ptr Word8)) length_ <- allocMem :: IO (Ptr Word64) etag_out <- allocMem :: IO (Ptr CString) onException (do _ <- propagateGError $ g_file_load_contents_finish _obj' res' contents length_ etag_out length_' <- peek length_ contents' <- peek contents contents'' <- (unpackByteStringWithLength length_') contents' freeMem contents' etag_out' <- peek etag_out etag_out'' <- cstringToText etag_out' freeMem etag_out' touchManagedPtr _obj touchManagedPtr res freeMem contents freeMem length_ freeMem etag_out return (contents'', etag_out'') ) (do freeMem contents freeMem length_ freeMem etag_out ) -- method File::load_partial_contents_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "contents", argType = TCArray False (-1) 3 (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},Arg {argName = "etag_out", argType = TBasicType TUTF8, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", 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_load_partial_contents_finish" g_file_load_partial_contents_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr Word8) -> -- contents : TCArray False (-1) 3 (TBasicType TUInt8) Ptr Word64 -> -- length : TBasicType TUInt64 Ptr CString -> -- etag_out : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt fileLoadPartialContentsFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m (ByteString,T.Text) fileLoadPartialContentsFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res contents <- allocMem :: IO (Ptr (Ptr Word8)) length_ <- allocMem :: IO (Ptr Word64) etag_out <- allocMem :: IO (Ptr CString) onException (do _ <- propagateGError $ g_file_load_partial_contents_finish _obj' res' contents length_ etag_out length_' <- peek length_ contents' <- peek contents contents'' <- (unpackByteStringWithLength length_') contents' freeMem contents' etag_out' <- peek etag_out etag_out'' <- cstringToText etag_out' freeMem etag_out' touchManagedPtr _obj touchManagedPtr res freeMem contents freeMem length_ freeMem etag_out return (contents'', etag_out'') ) (do freeMem contents freeMem length_ freeMem etag_out ) -- method File::make_directory -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_make_directory" g_file_make_directory :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileMakeDirectory :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () fileMakeDirectory _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_make_directory _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method File::make_directory_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_make_directory_async" g_file_make_directory_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileMakeDirectoryAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileMakeDirectoryAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_make_directory_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::make_directory_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_make_directory_finish" g_file_make_directory_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileMakeDirectoryFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileMakeDirectoryFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_make_directory_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::make_directory_with_parents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_make_directory_with_parents" g_file_make_directory_with_parents :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileMakeDirectoryWithParents :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () fileMakeDirectoryWithParents _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_make_directory_with_parents _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method File::make_symbolic_link -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symlink_value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symlink_value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_make_symbolic_link" g_file_make_symbolic_link :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- symlink_value : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileMakeSymbolicLink :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- symlink_value Maybe (b) -> -- cancellable m () fileMakeSymbolicLink _obj symlink_value cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj symlink_value' <- textToCString symlink_value maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_make_symbolic_link _obj' symlink_value' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem symlink_value' return () ) (do freeMem symlink_value' ) -- method File::measure_disk_usage_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "disk_usage", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "num_dirs", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "num_files", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_measure_disk_usage_finish" g_file_measure_disk_usage_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr Word64 -> -- disk_usage : TBasicType TUInt64 Ptr Word64 -> -- num_dirs : TBasicType TUInt64 Ptr Word64 -> -- num_files : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CInt fileMeasureDiskUsageFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m (Word64,Word64,Word64) fileMeasureDiskUsageFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ disk_usage <- allocMem :: IO (Ptr Word64) num_dirs <- allocMem :: IO (Ptr Word64) num_files <- allocMem :: IO (Ptr Word64) onException (do _ <- propagateGError $ g_file_measure_disk_usage_finish _obj' result_' disk_usage num_dirs num_files disk_usage' <- peek disk_usage num_dirs' <- peek num_dirs num_files' <- peek num_files touchManagedPtr _obj touchManagedPtr result_ freeMem disk_usage freeMem num_dirs freeMem num_files return (disk_usage', num_dirs', num_files') ) (do freeMem disk_usage freeMem num_dirs freeMem num_files ) -- method File::monitor -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileMonitorFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileMonitorFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileMonitor" -- throws : True -- Skip return : False foreign import ccall "g_file_monitor" g_file_monitor :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileMonitorFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileMonitor) fileMonitor :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileMonitorFlags] -> -- flags Maybe (b) -> -- cancellable m FileMonitor fileMonitor _obj flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_monitor _obj' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_monitor" result result' <- (wrapObject FileMonitor) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::monitor_directory -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileMonitorFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileMonitorFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileMonitor" -- throws : True -- Skip return : False foreign import ccall "g_file_monitor_directory" g_file_monitor_directory :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileMonitorFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileMonitor) fileMonitorDirectory :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileMonitorFlags] -> -- flags Maybe (b) -> -- cancellable m FileMonitor fileMonitorDirectory _obj flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_monitor_directory _obj' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_monitor_directory" result result' <- (wrapObject FileMonitor) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::monitor_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileMonitorFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileMonitorFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileMonitor" -- throws : True -- Skip return : False foreign import ccall "g_file_monitor_file" g_file_monitor_file :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileMonitorFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileMonitor) fileMonitorFile :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileMonitorFlags] -> -- flags Maybe (b) -> -- cancellable m FileMonitor fileMonitorFile _obj flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_monitor_file _obj' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_monitor_file" result result' <- (wrapObject FileMonitor) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::mount_enclosing_volume -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountMountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountMountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_mount_enclosing_volume" g_file_mount_enclosing_volume :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "MountMountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileMountEnclosingVolume :: (MonadIO m, FileK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountMountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileMountEnclosingVolume _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_mount_enclosing_volume _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method File::mount_enclosing_volume_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_mount_enclosing_volume_finish" g_file_mount_enclosing_volume_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileMountEnclosingVolumeFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileMountEnclosingVolumeFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_mount_enclosing_volume_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::mount_mountable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountMountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountMountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_mount_mountable" g_file_mount_mountable :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "MountMountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileMountMountable :: (MonadIO m, FileK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountMountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileMountMountable _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_mount_mountable _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method File::mount_mountable_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : True -- Skip return : False foreign import ccall "g_file_mount_mountable_finish" g_file_mount_mountable_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr File) fileMountMountableFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m File fileMountMountableFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_file_mount_mountable_finish _obj' result_' checkUnexpectedReturnNULL "g_file_mount_mountable_finish" result result' <- (wrapObject File) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method File::move -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destination", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCopyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "progress_callback", argType = TInterface "Gio" "FileProgressCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 5, argDestroy = -1, transfer = TransferNothing},Arg {argName = "progress_callback_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destination", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCopyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "progress_callback", argType = TInterface "Gio" "FileProgressCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_move" g_file_move :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr File -> -- destination : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileCopyFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr FileProgressCallbackC -> -- progress_callback : TInterface "Gio" "FileProgressCallback" Ptr () -> -- progress_callback_data : TBasicType TVoid Ptr (Ptr GError) -> -- error IO CInt fileMove :: (MonadIO m, FileK a, FileK b, CancellableK c) => a -> -- _obj b -> -- destination [FileCopyFlags] -> -- flags Maybe (c) -> -- cancellable Maybe (FileProgressCallback) -> -- progress_callback m () fileMove _obj destination flags cancellable progress_callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let destination' = unsafeManagedPtrCastPtr destination let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' maybeProgress_callback <- case progress_callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jProgress_callback -> do jProgress_callback' <- mkFileProgressCallback (fileProgressCallbackWrapper Nothing jProgress_callback) return jProgress_callback' let progress_callback_data = nullPtr onException (do _ <- propagateGError $ g_file_move _obj' destination' flags' maybeCancellable maybeProgress_callback progress_callback_data safeFreeFunPtr $ castFunPtrToPtr maybeProgress_callback touchManagedPtr _obj touchManagedPtr destination whenJust cancellable touchManagedPtr return () ) (do safeFreeFunPtr $ castFunPtrToPtr maybeProgress_callback return () ) -- method File::open_readwrite -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileIOStream" -- throws : True -- Skip return : False foreign import ccall "g_file_open_readwrite" g_file_open_readwrite :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileIOStream) fileOpenReadwrite :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m FileIOStream fileOpenReadwrite _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_open_readwrite _obj' maybeCancellable checkUnexpectedReturnNULL "g_file_open_readwrite" result result' <- (wrapObject FileIOStream) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::open_readwrite_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_open_readwrite_async" g_file_open_readwrite_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileOpenReadwriteAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileOpenReadwriteAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_open_readwrite_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::open_readwrite_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileIOStream" -- throws : True -- Skip return : False foreign import ccall "g_file_open_readwrite_finish" g_file_open_readwrite_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileIOStream) fileOpenReadwriteFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileIOStream fileOpenReadwriteFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_open_readwrite_finish _obj' res' checkUnexpectedReturnNULL "g_file_open_readwrite_finish" result result' <- (wrapObject FileIOStream) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::poll_mountable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_poll_mountable" g_file_poll_mountable :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () filePollMountable :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () filePollMountable _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_poll_mountable _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::poll_mountable_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_poll_mountable_finish" g_file_poll_mountable_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt filePollMountableFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () filePollMountableFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_poll_mountable_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::query_default_handler -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "AppInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_query_default_handler" g_file_query_default_handler :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr AppInfo) fileQueryDefaultHandler :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m AppInfo fileQueryDefaultHandler _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_query_default_handler _obj' maybeCancellable checkUnexpectedReturnNULL "g_file_query_default_handler" result result' <- (wrapObject AppInfo) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::query_exists -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_file_query_exists" g_file_query_exists :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" IO CInt fileQueryExists :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Bool fileQueryExists _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' result <- g_file_query_exists _obj' maybeCancellable let result' = (/= 0) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' -- method File::query_file_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileType" -- throws : False -- Skip return : False foreign import ccall "g_file_query_file_type" g_file_query_file_type :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" IO CUInt fileQueryFileType :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m FileType fileQueryFileType _obj flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' result <- g_file_query_file_type _obj' flags' maybeCancellable let result' = (toEnum . fromIntegral) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' -- method File::query_filesystem_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_query_filesystem_info" g_file_query_filesystem_info :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attributes : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileQueryFilesystemInfo :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes Maybe (b) -> -- cancellable m FileInfo fileQueryFilesystemInfo _obj attributes cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_query_filesystem_info _obj' attributes' maybeCancellable checkUnexpectedReturnNULL "g_file_query_filesystem_info" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return result' ) (do freeMem attributes' ) -- method File::query_filesystem_info_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_query_filesystem_info_async" g_file_query_filesystem_info_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attributes : TBasicType TUTF8 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileQueryFilesystemInfoAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileQueryFilesystemInfoAsync _obj attributes io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_query_filesystem_info_async _obj' attributes' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return () -- method File::query_filesystem_info_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_query_filesystem_info_finish" g_file_query_filesystem_info_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileQueryFilesystemInfoFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileInfo fileQueryFilesystemInfoFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_query_filesystem_info_finish _obj' res' checkUnexpectedReturnNULL "g_file_query_filesystem_info_finish" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::query_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_query_info" g_file_query_info :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attributes : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileQueryInfo :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m FileInfo fileQueryInfo _obj attributes flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_query_info _obj' attributes' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_query_info" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return result' ) (do freeMem attributes' ) -- method File::query_info_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_query_info_async" g_file_query_info_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attributes : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileQueryInfoAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes [FileQueryInfoFlags] -> -- flags Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileQueryInfoAsync _obj attributes flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_query_info_async _obj' attributes' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return () -- method File::query_info_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_query_info_finish" g_file_query_info_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileQueryInfoFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileInfo fileQueryInfoFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_query_info_finish _obj' res' checkUnexpectedReturnNULL "g_file_query_info_finish" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::query_settable_attributes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeInfoList" -- throws : True -- Skip return : False foreign import ccall "g_file_query_settable_attributes" g_file_query_settable_attributes :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileAttributeInfoList) fileQuerySettableAttributes :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m FileAttributeInfoList fileQuerySettableAttributes _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_query_settable_attributes _obj' maybeCancellable checkUnexpectedReturnNULL "g_file_query_settable_attributes" result result' <- (wrapBoxed FileAttributeInfoList) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::query_writable_namespaces -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeInfoList" -- throws : True -- Skip return : False foreign import ccall "g_file_query_writable_namespaces" g_file_query_writable_namespaces :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileAttributeInfoList) fileQueryWritableNamespaces :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m FileAttributeInfoList fileQueryWritableNamespaces _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_query_writable_namespaces _obj' maybeCancellable checkUnexpectedReturnNULL "g_file_query_writable_namespaces" result result' <- (wrapBoxed FileAttributeInfoList) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::read -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInputStream" -- throws : True -- Skip return : False foreign import ccall "g_file_read" g_file_read :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileInputStream) fileRead :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m FileInputStream fileRead _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_read _obj' maybeCancellable checkUnexpectedReturnNULL "g_file_read" result result' <- (wrapObject FileInputStream) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method File::read_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_read_async" g_file_read_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileReadAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileReadAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_read_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::read_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInputStream" -- throws : True -- Skip return : False foreign import ccall "g_file_read_finish" g_file_read_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileInputStream) fileReadFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileInputStream fileReadFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_read_finish _obj' res' checkUnexpectedReturnNULL "g_file_read_finish" result result' <- (wrapObject FileInputStream) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::replace -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileOutputStream" -- throws : True -- Skip return : False foreign import ccall "g_file_replace" g_file_replace :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- etag : TBasicType TUTF8 CInt -> -- make_backup : TBasicType TBoolean CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileOutputStream) fileReplace :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (T.Text) -> -- etag Bool -> -- make_backup [FileCreateFlags] -> -- flags Maybe (b) -> -- cancellable m FileOutputStream fileReplace _obj etag make_backup flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeEtag <- case etag of Nothing -> return nullPtr Just jEtag -> do jEtag' <- textToCString jEtag return jEtag' let make_backup' = (fromIntegral . fromEnum) make_backup let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_replace _obj' maybeEtag make_backup' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_replace" result result' <- (wrapObject FileOutputStream) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem maybeEtag return result' ) (do freeMem maybeEtag ) -- method File::replace_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_replace_async" g_file_replace_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- etag : TBasicType TUTF8 CInt -> -- make_backup : TBasicType TBoolean CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileReplaceAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (T.Text) -> -- etag Bool -> -- make_backup [FileCreateFlags] -> -- flags Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileReplaceAsync _obj etag make_backup flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeEtag <- case etag of Nothing -> return nullPtr Just jEtag -> do jEtag' <- textToCString jEtag return jEtag' let make_backup' = (fromIntegral . fromEnum) make_backup let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_replace_async _obj' maybeEtag make_backup' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem maybeEtag return () -- method File::replace_contents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", 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 TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_etag", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, 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 "Gio" "File", 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 = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_replace_contents" g_file_replace_contents :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Word8 -> -- contents : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- length : TBasicType TUInt64 CString -> -- etag : TBasicType TUTF8 CInt -> -- make_backup : TBasicType TBoolean CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Ptr CString -> -- new_etag : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileReplaceContents :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj ByteString -> -- contents Maybe (T.Text) -> -- etag Bool -> -- make_backup [FileCreateFlags] -> -- flags Maybe (b) -> -- cancellable m (T.Text) fileReplaceContents _obj contents etag make_backup flags cancellable = liftIO $ do let length_ = fromIntegral $ B.length contents let _obj' = unsafeManagedPtrCastPtr _obj contents' <- packByteString contents maybeEtag <- case etag of Nothing -> return nullPtr Just jEtag -> do jEtag' <- textToCString jEtag return jEtag' let make_backup' = (fromIntegral . fromEnum) make_backup let flags' = gflagsToWord flags new_etag <- allocMem :: IO (Ptr CString) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_replace_contents _obj' contents' length_ maybeEtag make_backup' flags' new_etag maybeCancellable new_etag' <- peek new_etag new_etag'' <- cstringToText new_etag' freeMem new_etag' touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem contents' freeMem maybeEtag freeMem new_etag return new_etag'' ) (do freeMem contents' freeMem maybeEtag freeMem new_etag ) -- method File::replace_contents_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", 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 TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, 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 "Gio" "File", 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 = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_replace_contents_async" g_file_replace_contents_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Word8 -> -- contents : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- length : TBasicType TUInt64 CString -> -- etag : TBasicType TUTF8 CInt -> -- make_backup : TBasicType TBoolean CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileReplaceContentsAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj ByteString -> -- contents Maybe (T.Text) -> -- etag Bool -> -- make_backup [FileCreateFlags] -> -- flags Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileReplaceContentsAsync _obj contents etag make_backup flags cancellable callback = liftIO $ do let length_ = fromIntegral $ B.length contents let _obj' = unsafeManagedPtrCastPtr _obj contents' <- packByteString contents maybeEtag <- case etag of Nothing -> return nullPtr Just jEtag -> do jEtag' <- textToCString jEtag return jEtag' let make_backup' = (fromIntegral . fromEnum) make_backup let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_replace_contents_async _obj' contents' length_ maybeEtag make_backup' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem contents' freeMem maybeEtag return () -- method File::replace_contents_bytes_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "contents", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "contents", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_replace_contents_bytes_async" g_file_replace_contents_bytes_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr GLib.Bytes -> -- contents : TInterface "GLib" "Bytes" CString -> -- etag : TBasicType TUTF8 CInt -> -- make_backup : TBasicType TBoolean CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileReplaceContentsBytesAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj GLib.Bytes -> -- contents Maybe (T.Text) -> -- etag Bool -> -- make_backup [FileCreateFlags] -> -- flags Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileReplaceContentsBytesAsync _obj contents etag make_backup flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let contents' = unsafeManagedPtrGetPtr contents maybeEtag <- case etag of Nothing -> return nullPtr Just jEtag -> do jEtag' <- textToCString jEtag return jEtag' let make_backup' = (fromIntegral . fromEnum) make_backup let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_replace_contents_bytes_async _obj' contents' maybeEtag make_backup' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr contents whenJust cancellable touchManagedPtr freeMem maybeEtag return () -- method File::replace_contents_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_etag", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", 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_replace_contents_finish" g_file_replace_contents_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr CString -> -- new_etag : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt fileReplaceContentsFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m (T.Text) fileReplaceContentsFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res new_etag <- allocMem :: IO (Ptr CString) onException (do _ <- propagateGError $ g_file_replace_contents_finish _obj' res' new_etag new_etag' <- peek new_etag new_etag'' <- cstringToText new_etag' freeMem new_etag' touchManagedPtr _obj touchManagedPtr res freeMem new_etag return new_etag'' ) (do freeMem new_etag ) -- method File::replace_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileOutputStream" -- throws : True -- Skip return : False foreign import ccall "g_file_replace_finish" g_file_replace_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileOutputStream) fileReplaceFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileOutputStream fileReplaceFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_replace_finish _obj' res' checkUnexpectedReturnNULL "g_file_replace_finish" result result' <- (wrapObject FileOutputStream) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::replace_readwrite -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileIOStream" -- throws : True -- Skip return : False foreign import ccall "g_file_replace_readwrite" g_file_replace_readwrite :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- etag : TBasicType TUTF8 CInt -> -- make_backup : TBasicType TBoolean CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileIOStream) fileReplaceReadwrite :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (T.Text) -> -- etag Bool -> -- make_backup [FileCreateFlags] -> -- flags Maybe (b) -> -- cancellable m FileIOStream fileReplaceReadwrite _obj etag make_backup flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeEtag <- case etag of Nothing -> return nullPtr Just jEtag -> do jEtag' <- textToCString jEtag return jEtag' let make_backup' = (fromIntegral . fromEnum) make_backup let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_replace_readwrite _obj' maybeEtag make_backup' flags' maybeCancellable checkUnexpectedReturnNULL "g_file_replace_readwrite" result result' <- (wrapObject FileIOStream) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem maybeEtag return result' ) (do freeMem maybeEtag ) -- method File::replace_readwrite_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "etag", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "make_backup", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 7, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_replace_readwrite_async" g_file_replace_readwrite_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- etag : TBasicType TUTF8 CInt -> -- make_backup : TBasicType TBoolean CUInt -> -- flags : TInterface "Gio" "FileCreateFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileReplaceReadwriteAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (T.Text) -> -- etag Bool -> -- make_backup [FileCreateFlags] -> -- flags Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileReplaceReadwriteAsync _obj etag make_backup flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeEtag <- case etag of Nothing -> return nullPtr Just jEtag -> do jEtag' <- textToCString jEtag return jEtag' let make_backup' = (fromIntegral . fromEnum) make_backup let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_replace_readwrite_async _obj' maybeEtag make_backup' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem maybeEtag return () -- method File::replace_readwrite_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileIOStream" -- throws : True -- Skip return : False foreign import ccall "g_file_replace_readwrite_finish" g_file_replace_readwrite_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileIOStream) fileReplaceReadwriteFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m FileIOStream fileReplaceReadwriteFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_replace_readwrite_finish _obj' res' checkUnexpectedReturnNULL "g_file_replace_readwrite_finish" result result' <- (wrapObject FileIOStream) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::resolve_relative_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "relative_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "relative_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_resolve_relative_path" g_file_resolve_relative_path :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- relative_path : TBasicType TUTF8 IO (Ptr File) fileResolveRelativePath :: (MonadIO m, FileK a) => a -> -- _obj T.Text -> -- relative_path m File fileResolveRelativePath _obj relative_path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj relative_path' <- textToCString relative_path result <- g_file_resolve_relative_path _obj' relative_path' checkUnexpectedReturnNULL "g_file_resolve_relative_path" result result' <- (wrapObject File) result touchManagedPtr _obj freeMem relative_path' return result' -- method File::set_attribute -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "FileAttributeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value_p", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "FileAttributeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value_p", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_attribute" g_file_set_attribute :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attribute : TBasicType TUTF8 CUInt -> -- type : TInterface "Gio" "FileAttributeType" Ptr () -> -- value_p : TBasicType TVoid CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileSetAttribute :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attribute FileAttributeType -> -- type Maybe (Ptr ()) -> -- value_p [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m () fileSetAttribute _obj attribute type_ value_p flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let type_' = (fromIntegral . fromEnum) type_ maybeValue_p <- case value_p of Nothing -> return nullPtr Just jValue_p -> do return jValue_p let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_set_attribute _obj' attribute' type_' maybeValue_p flags' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attribute' return () ) (do freeMem attribute' ) -- method File::set_attribute_byte_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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 = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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 = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_attribute_byte_string" g_file_set_attribute_byte_string :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attribute : TBasicType TUTF8 CString -> -- value : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileSetAttributeByteString :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attribute T.Text -> -- value [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m () fileSetAttributeByteString _obj attribute value flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute value' <- textToCString value let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_set_attribute_byte_string _obj' attribute' value' flags' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attribute' freeMem value' return () ) (do freeMem attribute' freeMem value' ) -- method File::set_attribute_int32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_attribute_int32" g_file_set_attribute_int32 :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attribute : TBasicType TUTF8 Int32 -> -- value : TBasicType TInt32 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileSetAttributeInt32 :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attribute Int32 -> -- value [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m () fileSetAttributeInt32 _obj attribute value flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_set_attribute_int32 _obj' attribute' value flags' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attribute' return () ) (do freeMem attribute' ) -- method File::set_attribute_int64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_attribute_int64" g_file_set_attribute_int64 :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attribute : TBasicType TUTF8 Int64 -> -- value : TBasicType TInt64 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileSetAttributeInt64 :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attribute Int64 -> -- value [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m () fileSetAttributeInt64 _obj attribute value flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_set_attribute_int64 _obj' attribute' value flags' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attribute' return () ) (do freeMem attribute' ) -- method File::set_attribute_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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 = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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 = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_attribute_string" g_file_set_attribute_string :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attribute : TBasicType TUTF8 CString -> -- value : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileSetAttributeString :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attribute T.Text -> -- value [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m () fileSetAttributeString _obj attribute value flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute value' <- textToCString value let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_set_attribute_string _obj' attribute' value' flags' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attribute' freeMem value' return () ) (do freeMem attribute' freeMem value' ) -- method File::set_attribute_uint32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_attribute_uint32" g_file_set_attribute_uint32 :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attribute : TBasicType TUTF8 Word32 -> -- value : TBasicType TUInt32 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileSetAttributeUint32 :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attribute Word32 -> -- value [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m () fileSetAttributeUint32 _obj attribute value flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_set_attribute_uint32 _obj' attribute' value flags' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attribute' return () ) (do freeMem attribute' ) -- method File::set_attribute_uint64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_attribute_uint64" g_file_set_attribute_uint64 :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- attribute : TBasicType TUTF8 Word64 -> -- value : TBasicType TUInt64 CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileSetAttributeUint64 :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- attribute Word64 -> -- value [FileQueryInfoFlags] -> -- flags Maybe (b) -> -- cancellable m () fileSetAttributeUint64 _obj attribute value flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_set_attribute_uint64 _obj' attribute' value flags' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attribute' return () ) (do freeMem attribute' ) -- method File::set_attributes_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_set_attributes_async" g_file_set_attributes_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr FileInfo -> -- info : TInterface "Gio" "FileInfo" CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileSetAttributesAsync :: (MonadIO m, FileK a, FileInfoK b, CancellableK c) => a -> -- _obj b -> -- info [FileQueryInfoFlags] -> -- flags Int32 -> -- io_priority Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileSetAttributesAsync _obj info flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let info' = unsafeManagedPtrCastPtr info let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_set_attributes_async _obj' info' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr info whenJust cancellable touchManagedPtr return () -- method File::set_attributes_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "FileInfo", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_attributes_finish" g_file_set_attributes_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr FileInfo) -> -- info : TInterface "Gio" "FileInfo" Ptr (Ptr GError) -> -- error IO CInt fileSetAttributesFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m (FileInfo) fileSetAttributesFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ info <- allocMem :: IO (Ptr (Ptr FileInfo)) onException (do _ <- propagateGError $ g_file_set_attributes_finish _obj' result_' info info' <- peek info info'' <- (wrapObject FileInfo) info' touchManagedPtr _obj touchManagedPtr result_ freeMem info return info'' ) (do freeMem info ) -- method File::set_attributes_from_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileQueryInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_set_attributes_from_info" g_file_set_attributes_from_info :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr FileInfo -> -- info : TInterface "Gio" "FileInfo" CUInt -> -- flags : TInterface "Gio" "FileQueryInfoFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileSetAttributesFromInfo :: (MonadIO m, FileK a, FileInfoK b, CancellableK c) => a -> -- _obj b -> -- info [FileQueryInfoFlags] -> -- flags Maybe (c) -> -- cancellable m () fileSetAttributesFromInfo _obj info flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let info' = unsafeManagedPtrCastPtr info let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_set_attributes_from_info _obj' info' flags' maybeCancellable touchManagedPtr _obj touchManagedPtr info whenJust cancellable touchManagedPtr return () ) (do return () ) -- method File::set_display_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "display_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "display_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : True -- Skip return : False foreign import ccall "g_file_set_display_name" g_file_set_display_name :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- display_name : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr File) fileSetDisplayName :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- display_name Maybe (b) -> -- cancellable m File fileSetDisplayName _obj display_name cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj display_name' <- textToCString display_name maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_set_display_name _obj' display_name' maybeCancellable checkUnexpectedReturnNULL "g_file_set_display_name" result result' <- (wrapObject File) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem display_name' return result' ) (do freeMem display_name' ) -- method File::set_display_name_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "display_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "display_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_set_display_name_async" g_file_set_display_name_async :: Ptr File -> -- _obj : TInterface "Gio" "File" CString -> -- display_name : TBasicType TUTF8 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileSetDisplayNameAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj T.Text -> -- display_name Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileSetDisplayNameAsync _obj display_name io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj display_name' <- textToCString display_name maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_set_display_name_async _obj' display_name' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem display_name' return () -- method File::set_display_name_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : True -- Skip return : False foreign import ccall "g_file_set_display_name_finish" g_file_set_display_name_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr File) fileSetDisplayNameFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- res m File fileSetDisplayNameFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_file_set_display_name_finish _obj' res' checkUnexpectedReturnNULL "g_file_set_display_name_finish" result result' <- (wrapObject File) result touchManagedPtr _obj touchManagedPtr res return result' ) (do return () ) -- method File::start_mountable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DriveStartFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DriveStartFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_start_mountable" g_file_start_mountable :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "DriveStartFlags" Ptr MountOperation -> -- start_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileStartMountable :: (MonadIO m, FileK a, MountOperationK b, CancellableK c) => a -> -- _obj [DriveStartFlags] -> -- flags Maybe (b) -> -- start_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileStartMountable _obj flags start_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeStart_operation <- case start_operation of Nothing -> return nullPtr Just jStart_operation -> do let jStart_operation' = unsafeManagedPtrCastPtr jStart_operation return jStart_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_start_mountable _obj' flags' maybeStart_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust start_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method File::start_mountable_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_start_mountable_finish" g_file_start_mountable_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileStartMountableFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileStartMountableFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_start_mountable_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::stop_mountable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_stop_mountable" g_file_stop_mountable :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileStopMountable :: (MonadIO m, FileK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileStopMountable _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_stop_mountable _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method File::stop_mountable_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_stop_mountable_finish" g_file_stop_mountable_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileStopMountableFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileStopMountableFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_stop_mountable_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::supports_thread_contexts -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", 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_supports_thread_contexts" g_file_supports_thread_contexts :: Ptr File -> -- _obj : TInterface "Gio" "File" IO CInt fileSupportsThreadContexts :: (MonadIO m, FileK a) => a -> -- _obj m Bool fileSupportsThreadContexts _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_supports_thread_contexts _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method File::trash -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_trash" g_file_trash :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileTrash :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () fileTrash _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_trash _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method File::trash_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_trash_async" g_file_trash_async :: Ptr File -> -- _obj : TInterface "Gio" "File" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileTrashAsync :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileTrashAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_trash_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::trash_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_trash_finish" g_file_trash_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileTrashFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileTrashFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_trash_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::unmount_mountable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_unmount_mountable" g_file_unmount_mountable :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () {-# DEPRECATED fileUnmountMountable ["(Since version 2.22)","Use g_file_unmount_mountable_with_operation() instead."]#-} fileUnmountMountable :: (MonadIO m, FileK a, CancellableK b) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileUnmountMountable _obj flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_unmount_mountable _obj' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method File::unmount_mountable_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_unmount_mountable_finish" g_file_unmount_mountable_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt {-# DEPRECATED fileUnmountMountableFinish ["(Since version 2.22)","Use g_file_unmount_mountable_with_operation_finish()"," instead."]#-} fileUnmountMountableFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileUnmountMountableFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_unmount_mountable_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method File::unmount_mountable_with_operation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_unmount_mountable_with_operation" g_file_unmount_mountable_with_operation :: Ptr File -> -- _obj : TInterface "Gio" "File" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileUnmountMountableWithOperation :: (MonadIO m, FileK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileUnmountMountableWithOperation _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_unmount_mountable_with_operation _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method File::unmount_mountable_with_operation_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_unmount_mountable_with_operation_finish" g_file_unmount_mountable_with_operation_finish :: Ptr File -> -- _obj : TInterface "Gio" "File" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileUnmountMountableWithOperationFinish :: (MonadIO m, FileK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileUnmountMountableWithOperationFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_unmount_mountable_with_operation_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- struct FileAttributeInfo newtype FileAttributeInfo = FileAttributeInfo (ForeignPtr FileAttributeInfo) noFileAttributeInfo :: Maybe FileAttributeInfo noFileAttributeInfo = Nothing fileAttributeInfoReadName :: FileAttributeInfo -> IO T.Text fileAttributeInfoReadName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' fileAttributeInfoReadType :: FileAttributeInfo -> IO FileAttributeType fileAttributeInfoReadType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' fileAttributeInfoReadFlags :: FileAttributeInfo -> IO [FileAttributeInfoFlags] fileAttributeInfoReadFlags s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO CUInt let val' = wordToGFlags val return val' -- Flags FileAttributeInfoFlags data FileAttributeInfoFlags = FileAttributeInfoFlagsNone | FileAttributeInfoFlagsCopyWithFile | FileAttributeInfoFlagsCopyWhenMoved | AnotherFileAttributeInfoFlags Int deriving (Show, Eq) instance Enum FileAttributeInfoFlags where fromEnum FileAttributeInfoFlagsNone = 0 fromEnum FileAttributeInfoFlagsCopyWithFile = 1 fromEnum FileAttributeInfoFlagsCopyWhenMoved = 2 fromEnum (AnotherFileAttributeInfoFlags k) = k toEnum 0 = FileAttributeInfoFlagsNone toEnum 1 = FileAttributeInfoFlagsCopyWithFile toEnum 2 = FileAttributeInfoFlagsCopyWhenMoved toEnum k = AnotherFileAttributeInfoFlags k foreign import ccall "g_file_attribute_info_flags_get_type" c_g_file_attribute_info_flags_get_type :: IO GType instance BoxedEnum FileAttributeInfoFlags where boxedEnumType _ = c_g_file_attribute_info_flags_get_type instance IsGFlag FileAttributeInfoFlags -- struct FileAttributeInfoList newtype FileAttributeInfoList = FileAttributeInfoList (ForeignPtr FileAttributeInfoList) noFileAttributeInfoList :: Maybe FileAttributeInfoList noFileAttributeInfoList = Nothing foreign import ccall "g_file_attribute_info_list_get_type" c_g_file_attribute_info_list_get_type :: IO GType instance BoxedObject FileAttributeInfoList where boxedType _ = c_g_file_attribute_info_list_get_type fileAttributeInfoListReadInfos :: FileAttributeInfoList -> IO FileAttributeInfo fileAttributeInfoListReadInfos s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr FileAttributeInfo) val' <- (newPtr 16 FileAttributeInfo) val return val' fileAttributeInfoListReadNInfos :: FileAttributeInfoList -> IO Int32 fileAttributeInfoListReadNInfos s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int32 return val -- method FileAttributeInfoList::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "FileAttributeInfoList" -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_info_list_new" g_file_attribute_info_list_new :: IO (Ptr FileAttributeInfoList) fileAttributeInfoListNew :: (MonadIO m) => m FileAttributeInfoList fileAttributeInfoListNew = liftIO $ do result <- g_file_attribute_info_list_new checkUnexpectedReturnNULL "g_file_attribute_info_list_new" result result' <- (wrapBoxed FileAttributeInfoList) result return result' -- method FileAttributeInfoList::add -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", 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 = "type", argType = TInterface "Gio" "FileAttributeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileAttributeInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", 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 = "type", argType = TInterface "Gio" "FileAttributeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "FileAttributeInfoFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_info_list_add" g_file_attribute_info_list_add :: Ptr FileAttributeInfoList -> -- _obj : TInterface "Gio" "FileAttributeInfoList" CString -> -- name : TBasicType TUTF8 CUInt -> -- type : TInterface "Gio" "FileAttributeType" CUInt -> -- flags : TInterface "Gio" "FileAttributeInfoFlags" IO () fileAttributeInfoListAdd :: (MonadIO m) => FileAttributeInfoList -> -- _obj T.Text -> -- name FileAttributeType -> -- type [FileAttributeInfoFlags] -> -- flags m () fileAttributeInfoListAdd _obj name type_ flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name let type_' = (fromIntegral . fromEnum) type_ let flags' = gflagsToWord flags g_file_attribute_info_list_add _obj' name' type_' flags' touchManagedPtr _obj freeMem name' return () -- method FileAttributeInfoList::dup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeInfoList" -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_info_list_dup" g_file_attribute_info_list_dup :: Ptr FileAttributeInfoList -> -- _obj : TInterface "Gio" "FileAttributeInfoList" IO (Ptr FileAttributeInfoList) fileAttributeInfoListDup :: (MonadIO m) => FileAttributeInfoList -> -- _obj m FileAttributeInfoList fileAttributeInfoListDup _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_file_attribute_info_list_dup _obj' checkUnexpectedReturnNULL "g_file_attribute_info_list_dup" result result' <- (wrapBoxed FileAttributeInfoList) result touchManagedPtr _obj return result' -- method FileAttributeInfoList::lookup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", 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 "Gio" "FileAttributeInfoList", 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 : TInterface "Gio" "FileAttributeInfo" -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_info_list_lookup" g_file_attribute_info_list_lookup :: Ptr FileAttributeInfoList -> -- _obj : TInterface "Gio" "FileAttributeInfoList" CString -> -- name : TBasicType TUTF8 IO (Ptr FileAttributeInfo) fileAttributeInfoListLookup :: (MonadIO m) => FileAttributeInfoList -> -- _obj T.Text -> -- name m FileAttributeInfo fileAttributeInfoListLookup _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_file_attribute_info_list_lookup _obj' name' checkUnexpectedReturnNULL "g_file_attribute_info_list_lookup" result result' <- (newPtr 16 FileAttributeInfo) result touchManagedPtr _obj freeMem name' return result' -- method FileAttributeInfoList::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeInfoList" -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_info_list_ref" g_file_attribute_info_list_ref :: Ptr FileAttributeInfoList -> -- _obj : TInterface "Gio" "FileAttributeInfoList" IO (Ptr FileAttributeInfoList) fileAttributeInfoListRef :: (MonadIO m) => FileAttributeInfoList -> -- _obj m FileAttributeInfoList fileAttributeInfoListRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_file_attribute_info_list_ref _obj' checkUnexpectedReturnNULL "g_file_attribute_info_list_ref" result result' <- (wrapBoxed FileAttributeInfoList) result touchManagedPtr _obj return result' -- method FileAttributeInfoList::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeInfoList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_info_list_unref" g_file_attribute_info_list_unref :: Ptr FileAttributeInfoList -> -- _obj : TInterface "Gio" "FileAttributeInfoList" IO () fileAttributeInfoListUnref :: (MonadIO m) => FileAttributeInfoList -> -- _obj m () fileAttributeInfoListUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_file_attribute_info_list_unref _obj' touchManagedPtr _obj return () -- struct FileAttributeMatcher newtype FileAttributeMatcher = FileAttributeMatcher (ForeignPtr FileAttributeMatcher) noFileAttributeMatcher :: Maybe FileAttributeMatcher noFileAttributeMatcher = Nothing foreign import ccall "g_file_attribute_matcher_get_type" c_g_file_attribute_matcher_get_type :: IO GType instance BoxedObject FileAttributeMatcher where boxedType _ = c_g_file_attribute_matcher_get_type -- method FileAttributeMatcher::new -- method type : Constructor -- Args : [Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeMatcher" -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_matcher_new" g_file_attribute_matcher_new :: CString -> -- attributes : TBasicType TUTF8 IO (Ptr FileAttributeMatcher) fileAttributeMatcherNew :: (MonadIO m) => T.Text -> -- attributes m FileAttributeMatcher fileAttributeMatcherNew attributes = liftIO $ do attributes' <- textToCString attributes result <- g_file_attribute_matcher_new attributes' checkUnexpectedReturnNULL "g_file_attribute_matcher_new" result result' <- (wrapBoxed FileAttributeMatcher) result freeMem attributes' return result' -- method FileAttributeMatcher::enumerate_namespace -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ns", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ns", 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_file_attribute_matcher_enumerate_namespace" g_file_attribute_matcher_enumerate_namespace :: Ptr FileAttributeMatcher -> -- _obj : TInterface "Gio" "FileAttributeMatcher" CString -> -- ns : TBasicType TUTF8 IO CInt fileAttributeMatcherEnumerateNamespace :: (MonadIO m) => FileAttributeMatcher -> -- _obj T.Text -> -- ns m Bool fileAttributeMatcherEnumerateNamespace _obj ns = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ns' <- textToCString ns result <- g_file_attribute_matcher_enumerate_namespace _obj' ns' let result' = (/= 0) result touchManagedPtr _obj freeMem ns' return result' -- method FileAttributeMatcher::enumerate_next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_matcher_enumerate_next" g_file_attribute_matcher_enumerate_next :: Ptr FileAttributeMatcher -> -- _obj : TInterface "Gio" "FileAttributeMatcher" IO CString fileAttributeMatcherEnumerateNext :: (MonadIO m) => FileAttributeMatcher -> -- _obj m T.Text fileAttributeMatcherEnumerateNext _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_file_attribute_matcher_enumerate_next _obj' checkUnexpectedReturnNULL "g_file_attribute_matcher_enumerate_next" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FileAttributeMatcher::matches -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_attribute_matcher_matches" g_file_attribute_matcher_matches :: Ptr FileAttributeMatcher -> -- _obj : TInterface "Gio" "FileAttributeMatcher" CString -> -- attribute : TBasicType TUTF8 IO CInt fileAttributeMatcherMatches :: (MonadIO m) => FileAttributeMatcher -> -- _obj T.Text -> -- attribute m Bool fileAttributeMatcherMatches _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj attribute' <- textToCString attribute result <- g_file_attribute_matcher_matches _obj' attribute' let result' = (/= 0) result touchManagedPtr _obj freeMem attribute' return result' -- method FileAttributeMatcher::matches_only -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_attribute_matcher_matches_only" g_file_attribute_matcher_matches_only :: Ptr FileAttributeMatcher -> -- _obj : TInterface "Gio" "FileAttributeMatcher" CString -> -- attribute : TBasicType TUTF8 IO CInt fileAttributeMatcherMatchesOnly :: (MonadIO m) => FileAttributeMatcher -> -- _obj T.Text -> -- attribute m Bool fileAttributeMatcherMatchesOnly _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj attribute' <- textToCString attribute result <- g_file_attribute_matcher_matches_only _obj' attribute' let result' = (/= 0) result touchManagedPtr _obj freeMem attribute' return result' -- method FileAttributeMatcher::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeMatcher" -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_matcher_ref" g_file_attribute_matcher_ref :: Ptr FileAttributeMatcher -> -- _obj : TInterface "Gio" "FileAttributeMatcher" IO (Ptr FileAttributeMatcher) fileAttributeMatcherRef :: (MonadIO m) => FileAttributeMatcher -> -- _obj m FileAttributeMatcher fileAttributeMatcherRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_file_attribute_matcher_ref _obj' checkUnexpectedReturnNULL "g_file_attribute_matcher_ref" result result' <- (wrapBoxed FileAttributeMatcher) result touchManagedPtr _obj return result' -- method FileAttributeMatcher::subtract -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "subtract", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "subtract", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeMatcher" -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_matcher_subtract" g_file_attribute_matcher_subtract :: Ptr FileAttributeMatcher -> -- _obj : TInterface "Gio" "FileAttributeMatcher" Ptr FileAttributeMatcher -> -- subtract : TInterface "Gio" "FileAttributeMatcher" IO (Ptr FileAttributeMatcher) fileAttributeMatcherSubtract :: (MonadIO m) => FileAttributeMatcher -> -- _obj FileAttributeMatcher -> -- subtract m FileAttributeMatcher fileAttributeMatcherSubtract _obj subtract = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let subtract' = unsafeManagedPtrGetPtr subtract result <- g_file_attribute_matcher_subtract _obj' subtract' checkUnexpectedReturnNULL "g_file_attribute_matcher_subtract" result result' <- (wrapBoxed FileAttributeMatcher) result touchManagedPtr _obj touchManagedPtr subtract return result' -- method FileAttributeMatcher::to_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_matcher_to_string" g_file_attribute_matcher_to_string :: Ptr FileAttributeMatcher -> -- _obj : TInterface "Gio" "FileAttributeMatcher" IO CString fileAttributeMatcherToString :: (MonadIO m) => FileAttributeMatcher -> -- _obj m T.Text fileAttributeMatcherToString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_file_attribute_matcher_to_string _obj' checkUnexpectedReturnNULL "g_file_attribute_matcher_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FileAttributeMatcher::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_attribute_matcher_unref" g_file_attribute_matcher_unref :: Ptr FileAttributeMatcher -> -- _obj : TInterface "Gio" "FileAttributeMatcher" IO () fileAttributeMatcherUnref :: (MonadIO m) => FileAttributeMatcher -> -- _obj m () fileAttributeMatcherUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_file_attribute_matcher_unref _obj' touchManagedPtr _obj return () -- Enum FileAttributeStatus data FileAttributeStatus = FileAttributeStatusUnset | FileAttributeStatusSet | FileAttributeStatusErrorSetting | AnotherFileAttributeStatus Int deriving (Show, Eq) instance Enum FileAttributeStatus where fromEnum FileAttributeStatusUnset = 0 fromEnum FileAttributeStatusSet = 1 fromEnum FileAttributeStatusErrorSetting = 2 fromEnum (AnotherFileAttributeStatus k) = k toEnum 0 = FileAttributeStatusUnset toEnum 1 = FileAttributeStatusSet toEnum 2 = FileAttributeStatusErrorSetting toEnum k = AnotherFileAttributeStatus k foreign import ccall "g_file_attribute_status_get_type" c_g_file_attribute_status_get_type :: IO GType instance BoxedEnum FileAttributeStatus where boxedEnumType _ = c_g_file_attribute_status_get_type -- Enum FileAttributeType data FileAttributeType = FileAttributeTypeInvalid | FileAttributeTypeString | FileAttributeTypeByteString | FileAttributeTypeBoolean | FileAttributeTypeUint32 | FileAttributeTypeInt32 | FileAttributeTypeUint64 | FileAttributeTypeInt64 | FileAttributeTypeObject | FileAttributeTypeStringv | AnotherFileAttributeType Int deriving (Show, Eq) instance Enum FileAttributeType where fromEnum FileAttributeTypeInvalid = 0 fromEnum FileAttributeTypeString = 1 fromEnum FileAttributeTypeByteString = 2 fromEnum FileAttributeTypeBoolean = 3 fromEnum FileAttributeTypeUint32 = 4 fromEnum FileAttributeTypeInt32 = 5 fromEnum FileAttributeTypeUint64 = 6 fromEnum FileAttributeTypeInt64 = 7 fromEnum FileAttributeTypeObject = 8 fromEnum FileAttributeTypeStringv = 9 fromEnum (AnotherFileAttributeType k) = k toEnum 0 = FileAttributeTypeInvalid toEnum 1 = FileAttributeTypeString toEnum 2 = FileAttributeTypeByteString toEnum 3 = FileAttributeTypeBoolean toEnum 4 = FileAttributeTypeUint32 toEnum 5 = FileAttributeTypeInt32 toEnum 6 = FileAttributeTypeUint64 toEnum 7 = FileAttributeTypeInt64 toEnum 8 = FileAttributeTypeObject toEnum 9 = FileAttributeTypeStringv toEnum k = AnotherFileAttributeType k foreign import ccall "g_file_attribute_type_get_type" c_g_file_attribute_type_get_type :: IO GType instance BoxedEnum FileAttributeType where boxedEnumType _ = c_g_file_attribute_type_get_type -- Flags FileCopyFlags data FileCopyFlags = FileCopyFlagsNone | FileCopyFlagsOverwrite | FileCopyFlagsBackup | FileCopyFlagsNofollowSymlinks | FileCopyFlagsAllMetadata | FileCopyFlagsNoFallbackForMove | FileCopyFlagsTargetDefaultPerms | AnotherFileCopyFlags Int deriving (Show, Eq) instance Enum FileCopyFlags where fromEnum FileCopyFlagsNone = 0 fromEnum FileCopyFlagsOverwrite = 1 fromEnum FileCopyFlagsBackup = 2 fromEnum FileCopyFlagsNofollowSymlinks = 4 fromEnum FileCopyFlagsAllMetadata = 8 fromEnum FileCopyFlagsNoFallbackForMove = 16 fromEnum FileCopyFlagsTargetDefaultPerms = 32 fromEnum (AnotherFileCopyFlags k) = k toEnum 0 = FileCopyFlagsNone toEnum 1 = FileCopyFlagsOverwrite toEnum 2 = FileCopyFlagsBackup toEnum 4 = FileCopyFlagsNofollowSymlinks toEnum 8 = FileCopyFlagsAllMetadata toEnum 16 = FileCopyFlagsNoFallbackForMove toEnum 32 = FileCopyFlagsTargetDefaultPerms toEnum k = AnotherFileCopyFlags k foreign import ccall "g_file_copy_flags_get_type" c_g_file_copy_flags_get_type :: IO GType instance BoxedEnum FileCopyFlags where boxedEnumType _ = c_g_file_copy_flags_get_type instance IsGFlag FileCopyFlags -- Flags FileCreateFlags data FileCreateFlags = FileCreateFlagsNone | FileCreateFlagsPrivate | FileCreateFlagsReplaceDestination | AnotherFileCreateFlags Int deriving (Show, Eq) instance Enum FileCreateFlags where fromEnum FileCreateFlagsNone = 0 fromEnum FileCreateFlagsPrivate = 1 fromEnum FileCreateFlagsReplaceDestination = 2 fromEnum (AnotherFileCreateFlags k) = k toEnum 0 = FileCreateFlagsNone toEnum 1 = FileCreateFlagsPrivate toEnum 2 = FileCreateFlagsReplaceDestination toEnum k = AnotherFileCreateFlags k foreign import ccall "g_file_create_flags_get_type" c_g_file_create_flags_get_type :: IO GType instance BoxedEnum FileCreateFlags where boxedEnumType _ = c_g_file_create_flags_get_type instance IsGFlag FileCreateFlags -- interface FileDescriptorBased newtype FileDescriptorBased = FileDescriptorBased (ForeignPtr FileDescriptorBased) noFileDescriptorBased :: Maybe FileDescriptorBased noFileDescriptorBased = Nothing foreign import ccall "g_file_descriptor_based_get_type" c_g_file_descriptor_based_get_type :: IO GType type instance ParentTypes FileDescriptorBased = '[GObject.Object] instance GObject FileDescriptorBased where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_descriptor_based_get_type class GObject o => FileDescriptorBasedK o instance (GObject o, IsDescendantOf FileDescriptorBased o) => FileDescriptorBasedK o toFileDescriptorBased :: FileDescriptorBasedK o => o -> IO FileDescriptorBased toFileDescriptorBased = unsafeCastTo FileDescriptorBased -- method FileDescriptorBased::get_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileDescriptorBased", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileDescriptorBased", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_file_descriptor_based_get_fd" g_file_descriptor_based_get_fd :: Ptr FileDescriptorBased -> -- _obj : TInterface "Gio" "FileDescriptorBased" IO Int32 fileDescriptorBasedGetFd :: (MonadIO m, FileDescriptorBasedK a) => a -> -- _obj m Int32 fileDescriptorBasedGetFd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_descriptor_based_get_fd _obj' touchManagedPtr _obj return result -- object FileEnumerator newtype FileEnumerator = FileEnumerator (ForeignPtr FileEnumerator) noFileEnumerator :: Maybe FileEnumerator noFileEnumerator = Nothing foreign import ccall "g_file_enumerator_get_type" c_g_file_enumerator_get_type :: IO GType type instance ParentTypes FileEnumerator = '[GObject.Object] instance GObject FileEnumerator where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_enumerator_get_type class GObject o => FileEnumeratorK o instance (GObject o, IsDescendantOf FileEnumerator o) => FileEnumeratorK o toFileEnumerator :: FileEnumeratorK o => o -> IO FileEnumerator toFileEnumerator = unsafeCastTo FileEnumerator -- method FileEnumerator::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_enumerator_close" g_file_enumerator_close :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileEnumeratorClose :: (MonadIO m, FileEnumeratorK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () fileEnumeratorClose _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_enumerator_close _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method FileEnumerator::close_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_enumerator_close_async" g_file_enumerator_close_async :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileEnumeratorCloseAsync :: (MonadIO m, FileEnumeratorK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileEnumeratorCloseAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_enumerator_close_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method FileEnumerator::close_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_enumerator_close_finish" g_file_enumerator_close_finish :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt fileEnumeratorCloseFinish :: (MonadIO m, FileEnumeratorK a, AsyncResultK b) => a -> -- _obj b -> -- result m () fileEnumeratorCloseFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_file_enumerator_close_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method FileEnumerator::get_child -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_enumerator_get_child" g_file_enumerator_get_child :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" Ptr FileInfo -> -- info : TInterface "Gio" "FileInfo" IO (Ptr File) fileEnumeratorGetChild :: (MonadIO m, FileEnumeratorK a, FileInfoK b) => a -> -- _obj b -> -- info m File fileEnumeratorGetChild _obj info = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let info' = unsafeManagedPtrCastPtr info result <- g_file_enumerator_get_child _obj' info' checkUnexpectedReturnNULL "g_file_enumerator_get_child" result result' <- (wrapObject File) result touchManagedPtr _obj touchManagedPtr info return result' -- method FileEnumerator::get_container -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_enumerator_get_container" g_file_enumerator_get_container :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" IO (Ptr File) fileEnumeratorGetContainer :: (MonadIO m, FileEnumeratorK a) => a -> -- _obj m File fileEnumeratorGetContainer _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_enumerator_get_container _obj' checkUnexpectedReturnNULL "g_file_enumerator_get_container" result result' <- (newObject File) result touchManagedPtr _obj return result' -- method FileEnumerator::has_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", 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_enumerator_has_pending" g_file_enumerator_has_pending :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" IO CInt fileEnumeratorHasPending :: (MonadIO m, FileEnumeratorK a) => a -> -- _obj m Bool fileEnumeratorHasPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_enumerator_has_pending _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileEnumerator::is_closed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", 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_enumerator_is_closed" g_file_enumerator_is_closed :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" IO CInt fileEnumeratorIsClosed :: (MonadIO m, FileEnumeratorK a) => a -> -- _obj m Bool fileEnumeratorIsClosed _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_enumerator_is_closed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileEnumerator::iterate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_info", argType = TInterface "Gio" "FileInfo", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_child", argType = TInterface "Gio" "File", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_file_enumerator_iterate" g_file_enumerator_iterate :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" Ptr (Ptr FileInfo) -> -- out_info : TInterface "Gio" "FileInfo" Ptr (Ptr File) -> -- out_child : TInterface "Gio" "File" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt fileEnumeratorIterate :: (MonadIO m, FileEnumeratorK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m (FileInfo,File) fileEnumeratorIterate _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj out_info <- allocMem :: IO (Ptr (Ptr FileInfo)) out_child <- allocMem :: IO (Ptr (Ptr File)) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_file_enumerator_iterate _obj' out_info out_child maybeCancellable out_info' <- peek out_info out_info'' <- (newObject FileInfo) out_info' out_child' <- peek out_child out_child'' <- (newObject File) out_child' touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem out_info freeMem out_child return (out_info'', out_child'') ) (do freeMem out_info freeMem out_child ) -- method FileEnumerator::next_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_enumerator_next_file" g_file_enumerator_next_file :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileEnumeratorNextFile :: (MonadIO m, FileEnumeratorK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m FileInfo fileEnumeratorNextFile _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_enumerator_next_file _obj' maybeCancellable checkUnexpectedReturnNULL "g_file_enumerator_next_file" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method FileEnumerator::next_files_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_files", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_files", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_enumerator_next_files_async" g_file_enumerator_next_files_async :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" Int32 -> -- num_files : TBasicType TInt32 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileEnumeratorNextFilesAsync :: (MonadIO m, FileEnumeratorK a, CancellableK b) => a -> -- _obj Int32 -> -- num_files Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileEnumeratorNextFilesAsync _obj num_files io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_enumerator_next_files_async _obj' num_files io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method FileEnumerator::next_files_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "FileInfo") -- throws : True -- Skip return : False foreign import ccall "g_file_enumerator_next_files_finish" g_file_enumerator_next_files_finish :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr FileInfo))) fileEnumeratorNextFilesFinish :: (MonadIO m, FileEnumeratorK a, AsyncResultK b) => a -> -- _obj b -> -- result m [FileInfo] fileEnumeratorNextFilesFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_file_enumerator_next_files_finish _obj' result_' checkUnexpectedReturnNULL "g_file_enumerator_next_files_finish" result result' <- unpackGList result result'' <- mapM (wrapObject FileInfo) result' g_list_free result touchManagedPtr _obj touchManagedPtr result_ return result'' ) (do return () ) -- method FileEnumerator::set_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pending", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pending", 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_file_enumerator_set_pending" g_file_enumerator_set_pending :: Ptr FileEnumerator -> -- _obj : TInterface "Gio" "FileEnumerator" CInt -> -- pending : TBasicType TBoolean IO () fileEnumeratorSetPending :: (MonadIO m, FileEnumeratorK a) => a -> -- _obj Bool -> -- pending m () fileEnumeratorSetPending _obj pending = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let pending' = (fromIntegral . fromEnum) pending g_file_enumerator_set_pending _obj' pending' touchManagedPtr _obj return () -- object FileIOStream newtype FileIOStream = FileIOStream (ForeignPtr FileIOStream) noFileIOStream :: Maybe FileIOStream noFileIOStream = Nothing foreign import ccall "g_file_io_stream_get_type" c_g_file_io_stream_get_type :: IO GType type instance ParentTypes FileIOStream = '[IOStream, GObject.Object, Seekable] instance GObject FileIOStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_io_stream_get_type class GObject o => FileIOStreamK o instance (GObject o, IsDescendantOf FileIOStream o) => FileIOStreamK o toFileIOStream :: FileIOStreamK o => o -> IO FileIOStream toFileIOStream = unsafeCastTo FileIOStream -- method FileIOStream::get_etag -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_io_stream_get_etag" g_file_io_stream_get_etag :: Ptr FileIOStream -> -- _obj : TInterface "Gio" "FileIOStream" IO CString fileIOStreamGetEtag :: (MonadIO m, FileIOStreamK a) => a -> -- _obj m T.Text fileIOStreamGetEtag _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_io_stream_get_etag _obj' checkUnexpectedReturnNULL "g_file_io_stream_get_etag" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FileIOStream::query_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_io_stream_query_info" g_file_io_stream_query_info :: Ptr FileIOStream -> -- _obj : TInterface "Gio" "FileIOStream" CString -> -- attributes : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileIOStreamQueryInfo :: (MonadIO m, FileIOStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes Maybe (b) -> -- cancellable m FileInfo fileIOStreamQueryInfo _obj attributes cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_io_stream_query_info _obj' attributes' maybeCancellable checkUnexpectedReturnNULL "g_file_io_stream_query_info" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return result' ) (do freeMem attributes' ) -- method FileIOStream::query_info_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_io_stream_query_info_async" g_file_io_stream_query_info_async :: Ptr FileIOStream -> -- _obj : TInterface "Gio" "FileIOStream" CString -> -- attributes : TBasicType TUTF8 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileIOStreamQueryInfoAsync :: (MonadIO m, FileIOStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileIOStreamQueryInfoAsync _obj attributes io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_io_stream_query_info_async _obj' attributes' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return () -- method FileIOStream::query_info_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_io_stream_query_info_finish" g_file_io_stream_query_info_finish :: Ptr FileIOStream -> -- _obj : TInterface "Gio" "FileIOStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileIOStreamQueryInfoFinish :: (MonadIO m, FileIOStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m FileInfo fileIOStreamQueryInfoFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_file_io_stream_query_info_finish _obj' result_' checkUnexpectedReturnNULL "g_file_io_stream_query_info_finish" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- object FileIcon newtype FileIcon = FileIcon (ForeignPtr FileIcon) noFileIcon :: Maybe FileIcon noFileIcon = Nothing foreign import ccall "g_file_icon_get_type" c_g_file_icon_get_type :: IO GType type instance ParentTypes FileIcon = '[GObject.Object, Icon, LoadableIcon] instance GObject FileIcon where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_icon_get_type class GObject o => FileIconK o instance (GObject o, IsDescendantOf FileIcon o) => FileIconK o toFileIcon :: FileIconK o => o -> IO FileIcon toFileIcon = unsafeCastTo FileIcon -- method FileIcon::new -- method type : Constructor -- Args : [Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileIcon" -- throws : False -- Skip return : False foreign import ccall "g_file_icon_new" g_file_icon_new :: Ptr File -> -- file : TInterface "Gio" "File" IO (Ptr FileIcon) fileIconNew :: (MonadIO m, FileK a) => a -> -- file m FileIcon fileIconNew file = liftIO $ do let file' = unsafeManagedPtrCastPtr file result <- g_file_icon_new file' checkUnexpectedReturnNULL "g_file_icon_new" result result' <- (wrapObject FileIcon) result touchManagedPtr file return result' -- method FileIcon::get_file -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_icon_get_file" g_file_icon_get_file :: Ptr FileIcon -> -- _obj : TInterface "Gio" "FileIcon" IO (Ptr File) fileIconGetFile :: (MonadIO m, FileIconK a) => a -> -- _obj m File fileIconGetFile _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_icon_get_file _obj' checkUnexpectedReturnNULL "g_file_icon_get_file" result result' <- (newObject File) result touchManagedPtr _obj return result' -- object FileInfo newtype FileInfo = FileInfo (ForeignPtr FileInfo) noFileInfo :: Maybe FileInfo noFileInfo = Nothing foreign import ccall "g_file_info_get_type" c_g_file_info_get_type :: IO GType type instance ParentTypes FileInfo = '[GObject.Object] instance GObject FileInfo where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_info_get_type class GObject o => FileInfoK o instance (GObject o, IsDescendantOf FileInfo o) => FileInfoK o toFileInfo :: FileInfoK o => o -> IO FileInfo toFileInfo = unsafeCastTo FileInfo -- method FileInfo::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "FileInfo" -- throws : False -- Skip return : False foreign import ccall "g_file_info_new" g_file_info_new :: IO (Ptr FileInfo) fileInfoNew :: (MonadIO m) => m FileInfo fileInfoNew = liftIO $ do result <- g_file_info_new checkUnexpectedReturnNULL "g_file_info_new" result result' <- (wrapObject FileInfo) result return result' -- method FileInfo::clear_status -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_clear_status" g_file_info_clear_status :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO () fileInfoClearStatus :: (MonadIO m, FileInfoK a) => a -> -- _obj m () fileInfoClearStatus _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_file_info_clear_status _obj' touchManagedPtr _obj return () -- method FileInfo::copy_into -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_copy_into" g_file_info_copy_into :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" Ptr FileInfo -> -- dest_info : TInterface "Gio" "FileInfo" IO () fileInfoCopyInto :: (MonadIO m, FileInfoK a, FileInfoK b) => a -> -- _obj b -> -- dest_info m () fileInfoCopyInto _obj dest_info = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let dest_info' = unsafeManagedPtrCastPtr dest_info g_file_info_copy_into _obj' dest_info' touchManagedPtr _obj touchManagedPtr dest_info return () -- method FileInfo::dup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : False -- Skip return : False foreign import ccall "g_file_info_dup" g_file_info_dup :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO (Ptr FileInfo) fileInfoDup :: (MonadIO m, FileInfoK a) => a -> -- _obj m FileInfo fileInfoDup _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_dup _obj' checkUnexpectedReturnNULL "g_file_info_dup" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj return result' -- method FileInfo::get_attribute_as_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_as_string" g_file_info_get_attribute_as_string :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO CString fileInfoGetAttributeAsString :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m T.Text fileInfoGetAttributeAsString _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_as_string _obj' attribute' checkUnexpectedReturnNULL "g_file_info_get_attribute_as_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::get_attribute_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_boolean" g_file_info_get_attribute_boolean :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO CInt fileInfoGetAttributeBoolean :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m Bool fileInfoGetAttributeBoolean _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_boolean _obj' attribute' let result' = (/= 0) result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::get_attribute_byte_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_byte_string" g_file_info_get_attribute_byte_string :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO CString fileInfoGetAttributeByteString :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m T.Text fileInfoGetAttributeByteString _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_byte_string _obj' attribute' checkUnexpectedReturnNULL "g_file_info_get_attribute_byte_string" result result' <- cstringToText result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::get_attribute_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "FileAttributeType", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "value_pp", argType = TBasicType TVoid, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "status", argType = TInterface "Gio" "FileAttributeStatus", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_data" g_file_info_get_attribute_data :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 Ptr CUInt -> -- type : TInterface "Gio" "FileAttributeType" Ptr (Ptr ()) -> -- value_pp : TBasicType TVoid Ptr CUInt -> -- status : TInterface "Gio" "FileAttributeStatus" IO CInt fileInfoGetAttributeData :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m (Bool,FileAttributeType,(Ptr ()),FileAttributeStatus) fileInfoGetAttributeData _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute type_ <- allocMem :: IO (Ptr CUInt) value_pp <- allocMem :: IO (Ptr (Ptr ())) status <- allocMem :: IO (Ptr CUInt) result <- g_file_info_get_attribute_data _obj' attribute' type_ value_pp status let result' = (/= 0) result type_' <- peek type_ let type_'' = (toEnum . fromIntegral) type_' value_pp' <- peek value_pp status' <- peek status let status'' = (toEnum . fromIntegral) status' touchManagedPtr _obj freeMem attribute' freeMem type_ freeMem value_pp freeMem status return (result', type_'', value_pp', status'') -- method FileInfo::get_attribute_int32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_int32" g_file_info_get_attribute_int32 :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO Int32 fileInfoGetAttributeInt32 :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m Int32 fileInfoGetAttributeInt32 _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_int32 _obj' attribute' touchManagedPtr _obj freeMem attribute' return result -- method FileInfo::get_attribute_int64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_int64" g_file_info_get_attribute_int64 :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO Int64 fileInfoGetAttributeInt64 :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m Int64 fileInfoGetAttributeInt64 _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_int64 _obj' attribute' touchManagedPtr _obj freeMem attribute' return result -- method FileInfo::get_attribute_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_attribute_object" g_file_info_get_attribute_object :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO (Ptr GObject.Object) fileInfoGetAttributeObject :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m GObject.Object fileInfoGetAttributeObject _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_object _obj' attribute' checkUnexpectedReturnNULL "g_file_info_get_attribute_object" result result' <- (newObject GObject.Object) result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::get_attribute_status -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeStatus" -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_attribute_status" g_file_info_get_attribute_status :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO CUInt fileInfoGetAttributeStatus :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m FileAttributeStatus fileInfoGetAttributeStatus _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_status _obj' attribute' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::get_attribute_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_string" g_file_info_get_attribute_string :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO CString fileInfoGetAttributeString :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m T.Text fileInfoGetAttributeString _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_string _obj' attribute' checkUnexpectedReturnNULL "g_file_info_get_attribute_string" result result' <- cstringToText result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::get_attribute_stringv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_stringv" g_file_info_get_attribute_stringv :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO (Ptr CString) fileInfoGetAttributeStringv :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m [T.Text] fileInfoGetAttributeStringv _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_stringv _obj' attribute' checkUnexpectedReturnNULL "g_file_info_get_attribute_stringv" result result' <- unpackZeroTerminatedUTF8CArray result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::get_attribute_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileAttributeType" -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_attribute_type" g_file_info_get_attribute_type :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO CUInt fileInfoGetAttributeType :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m FileAttributeType fileInfoGetAttributeType _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_type _obj' attribute' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::get_attribute_uint32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_get_attribute_uint32" g_file_info_get_attribute_uint32 :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO Word32 fileInfoGetAttributeUint32 :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m Word32 fileInfoGetAttributeUint32 _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_uint32 _obj' attribute' touchManagedPtr _obj freeMem attribute' return result -- method FileInfo::get_attribute_uint64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_attribute_uint64" g_file_info_get_attribute_uint64 :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO Word64 fileInfoGetAttributeUint64 :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m Word64 fileInfoGetAttributeUint64 _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_get_attribute_uint64 _obj' attribute' touchManagedPtr _obj freeMem attribute' return result -- method FileInfo::get_content_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_content_type" g_file_info_get_content_type :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CString fileInfoGetContentType :: (MonadIO m, FileInfoK a) => a -> -- _obj m T.Text fileInfoGetContentType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_content_type _obj' checkUnexpectedReturnNULL "g_file_info_get_content_type" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FileInfo::get_deletion_date -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", 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_file_info_get_deletion_date" g_file_info_get_deletion_date :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO (Ptr GLib.DateTime) fileInfoGetDeletionDate :: (MonadIO m, FileInfoK a) => a -> -- _obj m GLib.DateTime fileInfoGetDeletionDate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_deletion_date _obj' checkUnexpectedReturnNULL "g_file_info_get_deletion_date" result result' <- (wrapBoxed GLib.DateTime) result touchManagedPtr _obj return result' -- method FileInfo::get_display_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_display_name" g_file_info_get_display_name :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CString fileInfoGetDisplayName :: (MonadIO m, FileInfoK a) => a -> -- _obj m T.Text fileInfoGetDisplayName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_display_name _obj' checkUnexpectedReturnNULL "g_file_info_get_display_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FileInfo::get_edit_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_edit_name" g_file_info_get_edit_name :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CString fileInfoGetEditName :: (MonadIO m, FileInfoK a) => a -> -- _obj m T.Text fileInfoGetEditName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_edit_name _obj' checkUnexpectedReturnNULL "g_file_info_get_edit_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FileInfo::get_etag -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_etag" g_file_info_get_etag :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CString fileInfoGetEtag :: (MonadIO m, FileInfoK a) => a -> -- _obj m T.Text fileInfoGetEtag _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_etag _obj' checkUnexpectedReturnNULL "g_file_info_get_etag" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FileInfo::get_file_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileType" -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_file_type" g_file_info_get_file_type :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CUInt fileInfoGetFileType :: (MonadIO m, FileInfoK a) => a -> -- _obj m FileType fileInfoGetFileType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_file_type _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method FileInfo::get_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_icon" g_file_info_get_icon :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO (Ptr Icon) fileInfoGetIcon :: (MonadIO m, FileInfoK a) => a -> -- _obj m Icon fileInfoGetIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_icon _obj' checkUnexpectedReturnNULL "g_file_info_get_icon" result result' <- (newObject Icon) result touchManagedPtr _obj return result' -- method FileInfo::get_is_backup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", 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_info_get_is_backup" g_file_info_get_is_backup :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CInt fileInfoGetIsBackup :: (MonadIO m, FileInfoK a) => a -> -- _obj m Bool fileInfoGetIsBackup _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_is_backup _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileInfo::get_is_hidden -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", 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_info_get_is_hidden" g_file_info_get_is_hidden :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CInt fileInfoGetIsHidden :: (MonadIO m, FileInfoK a) => a -> -- _obj m Bool fileInfoGetIsHidden _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_is_hidden _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileInfo::get_is_symlink -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", 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_info_get_is_symlink" g_file_info_get_is_symlink :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CInt fileInfoGetIsSymlink :: (MonadIO m, FileInfoK a) => a -> -- _obj m Bool fileInfoGetIsSymlink _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_is_symlink _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileInfo::get_modification_time -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "GLib" "TimeVal", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_modification_time" g_file_info_get_modification_time :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" Ptr GLib.TimeVal -> -- result : TInterface "GLib" "TimeVal" IO () fileInfoGetModificationTime :: (MonadIO m, FileInfoK a) => a -> -- _obj m (GLib.TimeVal) fileInfoGetModificationTime _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result_ <- callocBytes 16 :: IO (Ptr GLib.TimeVal) g_file_info_get_modification_time _obj' result_ result_' <- (wrapPtr GLib.TimeVal) result_ touchManagedPtr _obj return result_' -- method FileInfo::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_name" g_file_info_get_name :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CString fileInfoGetName :: (MonadIO m, FileInfoK a) => a -> -- _obj m T.Text fileInfoGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_name _obj' checkUnexpectedReturnNULL "g_file_info_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FileInfo::get_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_size" g_file_info_get_size :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO Int64 fileInfoGetSize :: (MonadIO m, FileInfoK a) => a -> -- _obj m Int64 fileInfoGetSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_size _obj' touchManagedPtr _obj return result -- method FileInfo::get_sort_order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_sort_order" g_file_info_get_sort_order :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO Int32 fileInfoGetSortOrder :: (MonadIO m, FileInfoK a) => a -> -- _obj m Int32 fileInfoGetSortOrder _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_sort_order _obj' touchManagedPtr _obj return result -- method FileInfo::get_symbolic_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_symbolic_icon" g_file_info_get_symbolic_icon :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO (Ptr Icon) fileInfoGetSymbolicIcon :: (MonadIO m, FileInfoK a) => a -> -- _obj m Icon fileInfoGetSymbolicIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_symbolic_icon _obj' checkUnexpectedReturnNULL "g_file_info_get_symbolic_icon" result result' <- (newObject Icon) result touchManagedPtr _obj return result' -- method FileInfo::get_symlink_target -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_info_get_symlink_target" g_file_info_get_symlink_target :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO CString fileInfoGetSymlinkTarget :: (MonadIO m, FileInfoK a) => a -> -- _obj m T.Text fileInfoGetSymlinkTarget _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_info_get_symlink_target _obj' checkUnexpectedReturnNULL "g_file_info_get_symlink_target" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FileInfo::has_attribute -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_has_attribute" g_file_info_has_attribute :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO CInt fileInfoHasAttribute :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m Bool fileInfoHasAttribute _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute result <- g_file_info_has_attribute _obj' attribute' let result' = (/= 0) result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::has_namespace -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_space", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_space", 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_file_info_has_namespace" g_file_info_has_namespace :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- name_space : TBasicType TUTF8 IO CInt fileInfoHasNamespace :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- name_space m Bool fileInfoHasNamespace _obj name_space = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name_space' <- textToCString name_space result <- g_file_info_has_namespace _obj' name_space' let result' = (/= 0) result touchManagedPtr _obj freeMem name_space' return result' -- method FileInfo::list_attributes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_space", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_space", 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_file_info_list_attributes" g_file_info_list_attributes :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- name_space : TBasicType TUTF8 IO (Ptr CString) fileInfoListAttributes :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- name_space m [T.Text] fileInfoListAttributes _obj name_space = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name_space' <- textToCString name_space result <- g_file_info_list_attributes _obj' name_space' checkUnexpectedReturnNULL "g_file_info_list_attributes" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj freeMem name_space' return result' -- method FileInfo::remove_attribute -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_file_info_remove_attribute" g_file_info_remove_attribute :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 IO () fileInfoRemoveAttribute :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute m () fileInfoRemoveAttribute _obj attribute = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute g_file_info_remove_attribute _obj' attribute' touchManagedPtr _obj freeMem attribute' return () -- method FileInfo::set_attribute -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "FileAttributeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value_p", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "FileAttributeType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value_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_file_info_set_attribute" g_file_info_set_attribute :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 CUInt -> -- type : TInterface "Gio" "FileAttributeType" Ptr () -> -- value_p : TBasicType TVoid IO () fileInfoSetAttribute :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute FileAttributeType -> -- type Ptr () -> -- value_p m () fileInfoSetAttribute _obj attribute type_ value_p = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let type_' = (fromIntegral . fromEnum) type_ g_file_info_set_attribute _obj' attribute' type_' value_p touchManagedPtr _obj freeMem attribute' return () -- method FileInfo::set_attribute_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_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_file_info_set_attribute_boolean" g_file_info_set_attribute_boolean :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 CInt -> -- attr_value : TBasicType TBoolean IO () fileInfoSetAttributeBoolean :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute Bool -> -- attr_value m () fileInfoSetAttributeBoolean _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let attr_value' = (fromIntegral . fromEnum) attr_value g_file_info_set_attribute_boolean _obj' attribute' attr_value' touchManagedPtr _obj freeMem attribute' return () -- method FileInfo::set_attribute_byte_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_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_file_info_set_attribute_byte_string" g_file_info_set_attribute_byte_string :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 CString -> -- attr_value : TBasicType TUTF8 IO () fileInfoSetAttributeByteString :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute T.Text -> -- attr_value m () fileInfoSetAttributeByteString _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute attr_value' <- textToCString attr_value g_file_info_set_attribute_byte_string _obj' attribute' attr_value' touchManagedPtr _obj freeMem attribute' freeMem attr_value' return () -- method FileInfo::set_attribute_int32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_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_file_info_set_attribute_int32" g_file_info_set_attribute_int32 :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 Int32 -> -- attr_value : TBasicType TInt32 IO () fileInfoSetAttributeInt32 :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute Int32 -> -- attr_value m () fileInfoSetAttributeInt32 _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute g_file_info_set_attribute_int32 _obj' attribute' attr_value touchManagedPtr _obj freeMem attribute' return () -- method FileInfo::set_attribute_int64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_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_file_info_set_attribute_int64" g_file_info_set_attribute_int64 :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 Int64 -> -- attr_value : TBasicType TInt64 IO () fileInfoSetAttributeInt64 :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute Int64 -> -- attr_value m () fileInfoSetAttributeInt64 _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute g_file_info_set_attribute_int64 _obj' attribute' attr_value touchManagedPtr _obj freeMem attribute' return () -- method FileInfo::set_attribute_mask -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "Gio" "FileAttributeMatcher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_set_attribute_mask" g_file_info_set_attribute_mask :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" Ptr FileAttributeMatcher -> -- mask : TInterface "Gio" "FileAttributeMatcher" IO () fileInfoSetAttributeMask :: (MonadIO m, FileInfoK a) => a -> -- _obj FileAttributeMatcher -> -- mask m () fileInfoSetAttributeMask _obj mask = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let mask' = unsafeManagedPtrGetPtr mask g_file_info_set_attribute_mask _obj' mask' touchManagedPtr _obj touchManagedPtr mask return () -- method FileInfo::set_attribute_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_set_attribute_object" g_file_info_set_attribute_object :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 Ptr GObject.Object -> -- attr_value : TInterface "GObject" "Object" IO () fileInfoSetAttributeObject :: (MonadIO m, FileInfoK a, GObject.ObjectK b) => a -> -- _obj T.Text -> -- attribute b -> -- attr_value m () fileInfoSetAttributeObject _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let attr_value' = unsafeManagedPtrCastPtr attr_value g_file_info_set_attribute_object _obj' attribute' attr_value' touchManagedPtr _obj touchManagedPtr attr_value freeMem attribute' return () -- method FileInfo::set_attribute_status -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "status", argType = TInterface "Gio" "FileAttributeStatus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "status", argType = TInterface "Gio" "FileAttributeStatus", 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_info_set_attribute_status" g_file_info_set_attribute_status :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 CUInt -> -- status : TInterface "Gio" "FileAttributeStatus" IO CInt fileInfoSetAttributeStatus :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute FileAttributeStatus -> -- status m Bool fileInfoSetAttributeStatus _obj attribute status = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute let status' = (fromIntegral . fromEnum) status result <- g_file_info_set_attribute_status _obj' attribute' status' let result' = (/= 0) result touchManagedPtr _obj freeMem attribute' return result' -- method FileInfo::set_attribute_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_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_file_info_set_attribute_string" g_file_info_set_attribute_string :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 CString -> -- attr_value : TBasicType TUTF8 IO () fileInfoSetAttributeString :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute T.Text -> -- attr_value m () fileInfoSetAttributeString _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute attr_value' <- textToCString attr_value g_file_info_set_attribute_string _obj' attribute' attr_value' touchManagedPtr _obj freeMem attribute' freeMem attr_value' return () -- method FileInfo::set_attribute_stringv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TCArray False (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TCArray False (-1) (-1) (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_file_info_set_attribute_stringv" g_file_info_set_attribute_stringv :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 Ptr CString -> -- attr_value : TCArray False (-1) (-1) (TBasicType TUTF8) IO () fileInfoSetAttributeStringv :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute Ptr CString -> -- attr_value m () fileInfoSetAttributeStringv _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute g_file_info_set_attribute_stringv _obj' attribute' attr_value touchManagedPtr _obj freeMem attribute' return () -- method FileInfo::set_attribute_uint32 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", 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_file_info_set_attribute_uint32" g_file_info_set_attribute_uint32 :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 Word32 -> -- attr_value : TBasicType TUInt32 IO () fileInfoSetAttributeUint32 :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute Word32 -> -- attr_value m () fileInfoSetAttributeUint32 _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute g_file_info_set_attribute_uint32 _obj' attribute' attr_value touchManagedPtr _obj freeMem attribute' return () -- method FileInfo::set_attribute_uint64 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_value", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_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_file_info_set_attribute_uint64" g_file_info_set_attribute_uint64 :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- attribute : TBasicType TUTF8 Word64 -> -- attr_value : TBasicType TUInt64 IO () fileInfoSetAttributeUint64 :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- attribute Word64 -> -- attr_value m () fileInfoSetAttributeUint64 _obj attribute attr_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute g_file_info_set_attribute_uint64 _obj' attribute' attr_value touchManagedPtr _obj freeMem attribute' return () -- method FileInfo::set_content_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "content_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_file_info_set_content_type" g_file_info_set_content_type :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- content_type : TBasicType TUTF8 IO () fileInfoSetContentType :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- content_type m () fileInfoSetContentType _obj content_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj content_type' <- textToCString content_type g_file_info_set_content_type _obj' content_type' touchManagedPtr _obj freeMem content_type' return () -- method FileInfo::set_display_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "display_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "display_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_file_info_set_display_name" g_file_info_set_display_name :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- display_name : TBasicType TUTF8 IO () fileInfoSetDisplayName :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- display_name m () fileInfoSetDisplayName _obj display_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj display_name' <- textToCString display_name g_file_info_set_display_name _obj' display_name' touchManagedPtr _obj freeMem display_name' return () -- method FileInfo::set_edit_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "edit_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "edit_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_file_info_set_edit_name" g_file_info_set_edit_name :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- edit_name : TBasicType TUTF8 IO () fileInfoSetEditName :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- edit_name m () fileInfoSetEditName _obj edit_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj edit_name' <- textToCString edit_name g_file_info_set_edit_name _obj' edit_name' touchManagedPtr _obj freeMem edit_name' return () -- method FileInfo::set_file_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "FileType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "FileType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_set_file_type" g_file_info_set_file_type :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CUInt -> -- type : TInterface "Gio" "FileType" IO () fileInfoSetFileType :: (MonadIO m, FileInfoK a) => a -> -- _obj FileType -> -- type m () fileInfoSetFileType _obj type_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let type_' = (fromIntegral . fromEnum) type_ g_file_info_set_file_type _obj' type_' touchManagedPtr _obj return () -- method FileInfo::set_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_set_icon" g_file_info_set_icon :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" Ptr Icon -> -- icon : TInterface "Gio" "Icon" IO () fileInfoSetIcon :: (MonadIO m, FileInfoK a, IconK b) => a -> -- _obj b -> -- icon m () fileInfoSetIcon _obj icon = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let icon' = unsafeManagedPtrCastPtr icon g_file_info_set_icon _obj' icon' touchManagedPtr _obj touchManagedPtr icon return () -- method FileInfo::set_is_hidden -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_hidden", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_hidden", 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_file_info_set_is_hidden" g_file_info_set_is_hidden :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CInt -> -- is_hidden : TBasicType TBoolean IO () fileInfoSetIsHidden :: (MonadIO m, FileInfoK a) => a -> -- _obj Bool -> -- is_hidden m () fileInfoSetIsHidden _obj is_hidden = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let is_hidden' = (fromIntegral . fromEnum) is_hidden g_file_info_set_is_hidden _obj' is_hidden' touchManagedPtr _obj return () -- method FileInfo::set_is_symlink -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_symlink", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_symlink", 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_file_info_set_is_symlink" g_file_info_set_is_symlink :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CInt -> -- is_symlink : TBasicType TBoolean IO () fileInfoSetIsSymlink :: (MonadIO m, FileInfoK a) => a -> -- _obj Bool -> -- is_symlink m () fileInfoSetIsSymlink _obj is_symlink = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let is_symlink' = (fromIntegral . fromEnum) is_symlink g_file_info_set_is_symlink _obj' is_symlink' touchManagedPtr _obj return () -- method FileInfo::set_modification_time -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mtime", argType = TInterface "GLib" "TimeVal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mtime", 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_file_info_set_modification_time" g_file_info_set_modification_time :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" Ptr GLib.TimeVal -> -- mtime : TInterface "GLib" "TimeVal" IO () fileInfoSetModificationTime :: (MonadIO m, FileInfoK a) => a -> -- _obj GLib.TimeVal -> -- mtime m () fileInfoSetModificationTime _obj mtime = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let mtime' = unsafeManagedPtrGetPtr mtime g_file_info_set_modification_time _obj' mtime' touchManagedPtr _obj touchManagedPtr mtime return () -- method FileInfo::set_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", 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 "Gio" "FileInfo", 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_file_info_set_name" g_file_info_set_name :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- name : TBasicType TUTF8 IO () fileInfoSetName :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- name m () fileInfoSetName _obj name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- textToCString name g_file_info_set_name _obj' name' touchManagedPtr _obj freeMem name' return () -- method FileInfo::set_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", 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_file_info_set_size" g_file_info_set_size :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" Int64 -> -- size : TBasicType TInt64 IO () fileInfoSetSize :: (MonadIO m, FileInfoK a) => a -> -- _obj Int64 -> -- size m () fileInfoSetSize _obj size = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_file_info_set_size _obj' size touchManagedPtr _obj return () -- method FileInfo::set_sort_order -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sort_order", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sort_order", 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_file_info_set_sort_order" g_file_info_set_sort_order :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" Int32 -> -- sort_order : TBasicType TInt32 IO () fileInfoSetSortOrder :: (MonadIO m, FileInfoK a) => a -> -- _obj Int32 -> -- sort_order m () fileInfoSetSortOrder _obj sort_order = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_file_info_set_sort_order _obj' sort_order touchManagedPtr _obj return () -- method FileInfo::set_symbolic_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_set_symbolic_icon" g_file_info_set_symbolic_icon :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" Ptr Icon -> -- icon : TInterface "Gio" "Icon" IO () fileInfoSetSymbolicIcon :: (MonadIO m, FileInfoK a, IconK b) => a -> -- _obj b -> -- icon m () fileInfoSetSymbolicIcon _obj icon = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let icon' = unsafeManagedPtrCastPtr icon g_file_info_set_symbolic_icon _obj' icon' touchManagedPtr _obj touchManagedPtr icon return () -- method FileInfo::set_symlink_target -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symlink_target", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "symlink_target", 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_file_info_set_symlink_target" g_file_info_set_symlink_target :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" CString -> -- symlink_target : TBasicType TUTF8 IO () fileInfoSetSymlinkTarget :: (MonadIO m, FileInfoK a) => a -> -- _obj T.Text -> -- symlink_target m () fileInfoSetSymlinkTarget _obj symlink_target = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj symlink_target' <- textToCString symlink_target g_file_info_set_symlink_target _obj' symlink_target' touchManagedPtr _obj freeMem symlink_target' return () -- method FileInfo::unset_attribute_mask -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_info_unset_attribute_mask" g_file_info_unset_attribute_mask :: Ptr FileInfo -> -- _obj : TInterface "Gio" "FileInfo" IO () fileInfoUnsetAttributeMask :: (MonadIO m, FileInfoK a) => a -> -- _obj m () fileInfoUnsetAttributeMask _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_file_info_unset_attribute_mask _obj' touchManagedPtr _obj return () -- object FileInputStream newtype FileInputStream = FileInputStream (ForeignPtr FileInputStream) noFileInputStream :: Maybe FileInputStream noFileInputStream = Nothing foreign import ccall "g_file_input_stream_get_type" c_g_file_input_stream_get_type :: IO GType type instance ParentTypes FileInputStream = '[InputStream, GObject.Object, Seekable] instance GObject FileInputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_input_stream_get_type class GObject o => FileInputStreamK o instance (GObject o, IsDescendantOf FileInputStream o) => FileInputStreamK o toFileInputStream :: FileInputStreamK o => o -> IO FileInputStream toFileInputStream = unsafeCastTo FileInputStream -- method FileInputStream::query_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_input_stream_query_info" g_file_input_stream_query_info :: Ptr FileInputStream -> -- _obj : TInterface "Gio" "FileInputStream" CString -> -- attributes : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileInputStreamQueryInfo :: (MonadIO m, FileInputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes Maybe (b) -> -- cancellable m FileInfo fileInputStreamQueryInfo _obj attributes cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_input_stream_query_info _obj' attributes' maybeCancellable checkUnexpectedReturnNULL "g_file_input_stream_query_info" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return result' ) (do freeMem attributes' ) -- method FileInputStream::query_info_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_input_stream_query_info_async" g_file_input_stream_query_info_async :: Ptr FileInputStream -> -- _obj : TInterface "Gio" "FileInputStream" CString -> -- attributes : TBasicType TUTF8 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileInputStreamQueryInfoAsync :: (MonadIO m, FileInputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileInputStreamQueryInfoAsync _obj attributes io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_input_stream_query_info_async _obj' attributes' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return () -- method FileInputStream::query_info_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_input_stream_query_info_finish" g_file_input_stream_query_info_finish :: Ptr FileInputStream -> -- _obj : TInterface "Gio" "FileInputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileInputStreamQueryInfoFinish :: (MonadIO m, FileInputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m FileInfo fileInputStreamQueryInfoFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_file_input_stream_query_info_finish _obj' result_' checkUnexpectedReturnNULL "g_file_input_stream_query_info_finish" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- Flags FileMeasureFlags data FileMeasureFlags = FileMeasureFlagsNone | FileMeasureFlagsReportAnyError | FileMeasureFlagsApparentSize | FileMeasureFlagsNoXdev | AnotherFileMeasureFlags Int deriving (Show, Eq) instance Enum FileMeasureFlags where fromEnum FileMeasureFlagsNone = 0 fromEnum FileMeasureFlagsReportAnyError = 2 fromEnum FileMeasureFlagsApparentSize = 4 fromEnum FileMeasureFlagsNoXdev = 8 fromEnum (AnotherFileMeasureFlags k) = k toEnum 0 = FileMeasureFlagsNone toEnum 2 = FileMeasureFlagsReportAnyError toEnum 4 = FileMeasureFlagsApparentSize toEnum 8 = FileMeasureFlagsNoXdev toEnum k = AnotherFileMeasureFlags k foreign import ccall "g_file_measure_flags_get_type" c_g_file_measure_flags_get_type :: IO GType instance BoxedEnum FileMeasureFlags where boxedEnumType _ = c_g_file_measure_flags_get_type instance IsGFlag FileMeasureFlags -- callback FileMeasureProgressCallback fileMeasureProgressCallbackClosure :: FileMeasureProgressCallback -> IO Closure fileMeasureProgressCallbackClosure cb = newCClosure =<< mkFileMeasureProgressCallback wrapped where wrapped = fileMeasureProgressCallbackWrapper Nothing cb type FileMeasureProgressCallbackC = CInt -> Word64 -> Word64 -> Word64 -> Ptr () -> IO () foreign import ccall "wrapper" mkFileMeasureProgressCallback :: FileMeasureProgressCallbackC -> IO (FunPtr FileMeasureProgressCallbackC) type FileMeasureProgressCallback = Bool -> Word64 -> Word64 -> Word64 -> IO () noFileMeasureProgressCallback :: Maybe FileMeasureProgressCallback noFileMeasureProgressCallback = Nothing fileMeasureProgressCallbackWrapper :: Maybe (Ptr (FunPtr (FileMeasureProgressCallbackC))) -> FileMeasureProgressCallback -> CInt -> Word64 -> Word64 -> Word64 -> Ptr () -> IO () fileMeasureProgressCallbackWrapper funptrptr _cb reporting current_size num_dirs num_files _ = do let reporting' = (/= 0) reporting _cb reporting' current_size num_dirs num_files maybeReleaseFunPtr funptrptr -- object FileMonitor newtype FileMonitor = FileMonitor (ForeignPtr FileMonitor) noFileMonitor :: Maybe FileMonitor noFileMonitor = Nothing foreign import ccall "g_file_monitor_get_type" c_g_file_monitor_get_type :: IO GType type instance ParentTypes FileMonitor = '[GObject.Object] instance GObject FileMonitor where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_monitor_get_type class GObject o => FileMonitorK o instance (GObject o, IsDescendantOf FileMonitor o) => FileMonitorK o toFileMonitor :: FileMonitorK o => o -> IO FileMonitor toFileMonitor = unsafeCastTo FileMonitor -- method FileMonitor::cancel -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", 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_monitor_cancel" g_file_monitor_cancel :: Ptr FileMonitor -> -- _obj : TInterface "Gio" "FileMonitor" IO CInt fileMonitorCancel :: (MonadIO m, FileMonitorK a) => a -> -- _obj m Bool fileMonitorCancel _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_monitor_cancel _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileMonitor::emit_event -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other_file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_type", argType = TInterface "Gio" "FileMonitorEvent", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other_file", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event_type", argType = TInterface "Gio" "FileMonitorEvent", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_monitor_emit_event" g_file_monitor_emit_event :: Ptr FileMonitor -> -- _obj : TInterface "Gio" "FileMonitor" Ptr File -> -- child : TInterface "Gio" "File" Ptr File -> -- other_file : TInterface "Gio" "File" CUInt -> -- event_type : TInterface "Gio" "FileMonitorEvent" IO () fileMonitorEmitEvent :: (MonadIO m, FileMonitorK a, FileK b, FileK c) => a -> -- _obj b -> -- child c -> -- other_file FileMonitorEvent -> -- event_type m () fileMonitorEmitEvent _obj child other_file event_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child let other_file' = unsafeManagedPtrCastPtr other_file let event_type' = (fromIntegral . fromEnum) event_type g_file_monitor_emit_event _obj' child' other_file' event_type' touchManagedPtr _obj touchManagedPtr child touchManagedPtr other_file return () -- method FileMonitor::is_cancelled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", 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_monitor_is_cancelled" g_file_monitor_is_cancelled :: Ptr FileMonitor -> -- _obj : TInterface "Gio" "FileMonitor" IO CInt fileMonitorIsCancelled :: (MonadIO m, FileMonitorK a) => a -> -- _obj m Bool fileMonitorIsCancelled _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_monitor_is_cancelled _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FileMonitor::set_rate_limit -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit_msecs", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit_msecs", 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_file_monitor_set_rate_limit" g_file_monitor_set_rate_limit :: Ptr FileMonitor -> -- _obj : TInterface "Gio" "FileMonitor" Int32 -> -- limit_msecs : TBasicType TInt32 IO () fileMonitorSetRateLimit :: (MonadIO m, FileMonitorK a) => a -> -- _obj Int32 -> -- limit_msecs m () fileMonitorSetRateLimit _obj limit_msecs = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_file_monitor_set_rate_limit _obj' limit_msecs touchManagedPtr _obj return () -- signal FileMonitor::changed type FileMonitorChangedCallback = File -> Maybe File -> FileMonitorEvent -> IO () noFileMonitorChangedCallback :: Maybe FileMonitorChangedCallback noFileMonitorChangedCallback = Nothing type FileMonitorChangedCallbackC = Ptr () -> -- object Ptr File -> Ptr File -> CUInt -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkFileMonitorChangedCallback :: FileMonitorChangedCallbackC -> IO (FunPtr FileMonitorChangedCallbackC) fileMonitorChangedClosure :: FileMonitorChangedCallback -> IO Closure fileMonitorChangedClosure cb = newCClosure =<< mkFileMonitorChangedCallback wrapped where wrapped = fileMonitorChangedCallbackWrapper cb fileMonitorChangedCallbackWrapper :: FileMonitorChangedCallback -> Ptr () -> Ptr File -> Ptr File -> CUInt -> Ptr () -> IO () fileMonitorChangedCallbackWrapper _cb _ file other_file event_type _ = do file' <- (newObject File) file maybeOther_file <- if other_file == nullPtr then return Nothing else do other_file' <- (newObject File) other_file return $ Just other_file' let event_type' = (toEnum . fromIntegral) event_type _cb file' maybeOther_file event_type' onFileMonitorChanged :: (GObject a, MonadIO m) => a -> FileMonitorChangedCallback -> m SignalHandlerId onFileMonitorChanged obj cb = liftIO $ connectFileMonitorChanged obj cb SignalConnectBefore afterFileMonitorChanged :: (GObject a, MonadIO m) => a -> FileMonitorChangedCallback -> m SignalHandlerId afterFileMonitorChanged obj cb = connectFileMonitorChanged obj cb SignalConnectAfter connectFileMonitorChanged :: (GObject a, MonadIO m) => a -> FileMonitorChangedCallback -> SignalConnectMode -> m SignalHandlerId connectFileMonitorChanged obj cb after = liftIO $ do cb' <- mkFileMonitorChangedCallback (fileMonitorChangedCallbackWrapper cb) connectSignalFunPtr obj "changed" cb' after -- Enum FileMonitorEvent data FileMonitorEvent = FileMonitorEventChanged | FileMonitorEventChangesDoneHint | FileMonitorEventDeleted | FileMonitorEventCreated | FileMonitorEventAttributeChanged | FileMonitorEventPreUnmount | FileMonitorEventUnmounted | FileMonitorEventMoved | AnotherFileMonitorEvent Int deriving (Show, Eq) instance Enum FileMonitorEvent where fromEnum FileMonitorEventChanged = 0 fromEnum FileMonitorEventChangesDoneHint = 1 fromEnum FileMonitorEventDeleted = 2 fromEnum FileMonitorEventCreated = 3 fromEnum FileMonitorEventAttributeChanged = 4 fromEnum FileMonitorEventPreUnmount = 5 fromEnum FileMonitorEventUnmounted = 6 fromEnum FileMonitorEventMoved = 7 fromEnum (AnotherFileMonitorEvent k) = k toEnum 0 = FileMonitorEventChanged toEnum 1 = FileMonitorEventChangesDoneHint toEnum 2 = FileMonitorEventDeleted toEnum 3 = FileMonitorEventCreated toEnum 4 = FileMonitorEventAttributeChanged toEnum 5 = FileMonitorEventPreUnmount toEnum 6 = FileMonitorEventUnmounted toEnum 7 = FileMonitorEventMoved toEnum k = AnotherFileMonitorEvent k foreign import ccall "g_file_monitor_event_get_type" c_g_file_monitor_event_get_type :: IO GType instance BoxedEnum FileMonitorEvent where boxedEnumType _ = c_g_file_monitor_event_get_type -- Flags FileMonitorFlags data FileMonitorFlags = FileMonitorFlagsNone | FileMonitorFlagsWatchMounts | FileMonitorFlagsSendMoved | FileMonitorFlagsWatchHardLinks | AnotherFileMonitorFlags Int deriving (Show, Eq) instance Enum FileMonitorFlags where fromEnum FileMonitorFlagsNone = 0 fromEnum FileMonitorFlagsWatchMounts = 1 fromEnum FileMonitorFlagsSendMoved = 2 fromEnum FileMonitorFlagsWatchHardLinks = 4 fromEnum (AnotherFileMonitorFlags k) = k toEnum 0 = FileMonitorFlagsNone toEnum 1 = FileMonitorFlagsWatchMounts toEnum 2 = FileMonitorFlagsSendMoved toEnum 4 = FileMonitorFlagsWatchHardLinks toEnum k = AnotherFileMonitorFlags k foreign import ccall "g_file_monitor_flags_get_type" c_g_file_monitor_flags_get_type :: IO GType instance BoxedEnum FileMonitorFlags where boxedEnumType _ = c_g_file_monitor_flags_get_type instance IsGFlag FileMonitorFlags -- object FileOutputStream newtype FileOutputStream = FileOutputStream (ForeignPtr FileOutputStream) noFileOutputStream :: Maybe FileOutputStream noFileOutputStream = Nothing foreign import ccall "g_file_output_stream_get_type" c_g_file_output_stream_get_type :: IO GType type instance ParentTypes FileOutputStream = '[OutputStream, GObject.Object, Seekable] instance GObject FileOutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_file_output_stream_get_type class GObject o => FileOutputStreamK o instance (GObject o, IsDescendantOf FileOutputStream o) => FileOutputStreamK o toFileOutputStream :: FileOutputStreamK o => o -> IO FileOutputStream toFileOutputStream = unsafeCastTo FileOutputStream -- method FileOutputStream::get_etag -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_file_output_stream_get_etag" g_file_output_stream_get_etag :: Ptr FileOutputStream -> -- _obj : TInterface "Gio" "FileOutputStream" IO CString fileOutputStreamGetEtag :: (MonadIO m, FileOutputStreamK a) => a -> -- _obj m T.Text fileOutputStreamGetEtag _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_file_output_stream_get_etag _obj' checkUnexpectedReturnNULL "g_file_output_stream_get_etag" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FileOutputStream::query_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_output_stream_query_info" g_file_output_stream_query_info :: Ptr FileOutputStream -> -- _obj : TInterface "Gio" "FileOutputStream" CString -> -- attributes : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileOutputStreamQueryInfo :: (MonadIO m, FileOutputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes Maybe (b) -> -- cancellable m FileInfo fileOutputStreamQueryInfo _obj attributes cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_file_output_stream_query_info _obj' attributes' maybeCancellable checkUnexpectedReturnNULL "g_file_output_stream_query_info" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return result' ) (do freeMem attributes' ) -- method FileOutputStream::query_info_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_file_output_stream_query_info_async" g_file_output_stream_query_info_async :: Ptr FileOutputStream -> -- _obj : TInterface "Gio" "FileOutputStream" CString -> -- attributes : TBasicType TUTF8 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () fileOutputStreamQueryInfoAsync :: (MonadIO m, FileOutputStreamK a, CancellableK b) => a -> -- _obj T.Text -> -- attributes Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () fileOutputStreamQueryInfoAsync _obj attributes io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attributes' <- textToCString attributes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_file_output_stream_query_info_async _obj' attributes' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem attributes' return () -- method FileOutputStream::query_info_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FileOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FileOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : True -- Skip return : False foreign import ccall "g_file_output_stream_query_info_finish" g_file_output_stream_query_info_finish :: Ptr FileOutputStream -> -- _obj : TInterface "Gio" "FileOutputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr FileInfo) fileOutputStreamQueryInfoFinish :: (MonadIO m, FileOutputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m FileInfo fileOutputStreamQueryInfoFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_file_output_stream_query_info_finish _obj' result_' checkUnexpectedReturnNULL "g_file_output_stream_query_info_finish" result result' <- (wrapObject FileInfo) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- callback FileProgressCallback fileProgressCallbackClosure :: FileProgressCallback -> IO Closure fileProgressCallbackClosure cb = newCClosure =<< mkFileProgressCallback wrapped where wrapped = fileProgressCallbackWrapper Nothing cb type FileProgressCallbackC = Int64 -> Int64 -> Ptr () -> IO () foreign import ccall "wrapper" mkFileProgressCallback :: FileProgressCallbackC -> IO (FunPtr FileProgressCallbackC) type FileProgressCallback = Int64 -> Int64 -> IO () noFileProgressCallback :: Maybe FileProgressCallback noFileProgressCallback = Nothing fileProgressCallbackWrapper :: Maybe (Ptr (FunPtr (FileProgressCallbackC))) -> FileProgressCallback -> Int64 -> Int64 -> Ptr () -> IO () fileProgressCallbackWrapper funptrptr _cb current_num_bytes total_num_bytes _ = do _cb current_num_bytes total_num_bytes maybeReleaseFunPtr funptrptr -- Flags FileQueryInfoFlags data FileQueryInfoFlags = FileQueryInfoFlagsNone | FileQueryInfoFlagsNofollowSymlinks | AnotherFileQueryInfoFlags Int deriving (Show, Eq) instance Enum FileQueryInfoFlags where fromEnum FileQueryInfoFlagsNone = 0 fromEnum FileQueryInfoFlagsNofollowSymlinks = 1 fromEnum (AnotherFileQueryInfoFlags k) = k toEnum 0 = FileQueryInfoFlagsNone toEnum 1 = FileQueryInfoFlagsNofollowSymlinks toEnum k = AnotherFileQueryInfoFlags k foreign import ccall "g_file_query_info_flags_get_type" c_g_file_query_info_flags_get_type :: IO GType instance BoxedEnum FileQueryInfoFlags where boxedEnumType _ = c_g_file_query_info_flags_get_type instance IsGFlag FileQueryInfoFlags -- callback FileReadMoreCallback fileReadMoreCallbackClosure :: FileReadMoreCallback -> IO Closure fileReadMoreCallbackClosure cb = newCClosure =<< mkFileReadMoreCallback wrapped where wrapped = fileReadMoreCallbackWrapper Nothing cb type FileReadMoreCallbackC = CString -> Int64 -> Ptr () -> IO CInt foreign import ccall "wrapper" mkFileReadMoreCallback :: FileReadMoreCallbackC -> IO (FunPtr FileReadMoreCallbackC) type FileReadMoreCallback = T.Text -> Int64 -> Ptr () -> IO Bool noFileReadMoreCallback :: Maybe FileReadMoreCallback noFileReadMoreCallback = Nothing fileReadMoreCallbackWrapper :: Maybe (Ptr (FunPtr (FileReadMoreCallbackC))) -> FileReadMoreCallback -> CString -> Int64 -> Ptr () -> IO CInt fileReadMoreCallbackWrapper funptrptr _cb file_contents file_size callback_data = do file_contents' <- cstringToText file_contents result <- _cb file_contents' file_size callback_data maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Enum FileType data FileType = FileTypeUnknown | FileTypeRegular | FileTypeDirectory | FileTypeSymbolicLink | FileTypeSpecial | FileTypeShortcut | FileTypeMountable | AnotherFileType Int deriving (Show, Eq) instance Enum FileType where fromEnum FileTypeUnknown = 0 fromEnum FileTypeRegular = 1 fromEnum FileTypeDirectory = 2 fromEnum FileTypeSymbolicLink = 3 fromEnum FileTypeSpecial = 4 fromEnum FileTypeShortcut = 5 fromEnum FileTypeMountable = 6 fromEnum (AnotherFileType k) = k toEnum 0 = FileTypeUnknown toEnum 1 = FileTypeRegular toEnum 2 = FileTypeDirectory toEnum 3 = FileTypeSymbolicLink toEnum 4 = FileTypeSpecial toEnum 5 = FileTypeShortcut toEnum 6 = FileTypeMountable toEnum k = AnotherFileType k foreign import ccall "g_file_type_get_type" c_g_file_type_get_type :: IO GType instance BoxedEnum FileType where boxedEnumType _ = c_g_file_type_get_type -- object FilenameCompleter newtype FilenameCompleter = FilenameCompleter (ForeignPtr FilenameCompleter) noFilenameCompleter :: Maybe FilenameCompleter noFilenameCompleter = Nothing foreign import ccall "g_filename_completer_get_type" c_g_filename_completer_get_type :: IO GType type instance ParentTypes FilenameCompleter = '[GObject.Object] instance GObject FilenameCompleter where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_filename_completer_get_type class GObject o => FilenameCompleterK o instance (GObject o, IsDescendantOf FilenameCompleter o) => FilenameCompleterK o toFilenameCompleter :: FilenameCompleterK o => o -> IO FilenameCompleter toFilenameCompleter = unsafeCastTo FilenameCompleter -- method FilenameCompleter::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "FilenameCompleter" -- throws : False -- Skip return : False foreign import ccall "g_filename_completer_new" g_filename_completer_new :: IO (Ptr FilenameCompleter) filenameCompleterNew :: (MonadIO m) => m FilenameCompleter filenameCompleterNew = liftIO $ do result <- g_filename_completer_new checkUnexpectedReturnNULL "g_filename_completer_new" result result' <- (wrapObject FilenameCompleter) result return result' -- method FilenameCompleter::get_completion_suffix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilenameCompleter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "initial_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilenameCompleter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "initial_text", 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_completer_get_completion_suffix" g_filename_completer_get_completion_suffix :: Ptr FilenameCompleter -> -- _obj : TInterface "Gio" "FilenameCompleter" CString -> -- initial_text : TBasicType TUTF8 IO CString filenameCompleterGetCompletionSuffix :: (MonadIO m, FilenameCompleterK a) => a -> -- _obj T.Text -> -- initial_text m T.Text filenameCompleterGetCompletionSuffix _obj initial_text = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj initial_text' <- textToCString initial_text result <- g_filename_completer_get_completion_suffix _obj' initial_text' checkUnexpectedReturnNULL "g_filename_completer_get_completion_suffix" result result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem initial_text' return result' -- method FilenameCompleter::get_completions -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilenameCompleter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "initial_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilenameCompleter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "initial_text", 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_filename_completer_get_completions" g_filename_completer_get_completions :: Ptr FilenameCompleter -> -- _obj : TInterface "Gio" "FilenameCompleter" CString -> -- initial_text : TBasicType TUTF8 IO (Ptr CString) filenameCompleterGetCompletions :: (MonadIO m, FilenameCompleterK a) => a -> -- _obj T.Text -> -- initial_text m [T.Text] filenameCompleterGetCompletions _obj initial_text = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj initial_text' <- textToCString initial_text result <- g_filename_completer_get_completions _obj' initial_text' checkUnexpectedReturnNULL "g_filename_completer_get_completions" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj freeMem initial_text' return result' -- method FilenameCompleter::set_dirs_only -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilenameCompleter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dirs_only", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilenameCompleter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dirs_only", 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_filename_completer_set_dirs_only" g_filename_completer_set_dirs_only :: Ptr FilenameCompleter -> -- _obj : TInterface "Gio" "FilenameCompleter" CInt -> -- dirs_only : TBasicType TBoolean IO () filenameCompleterSetDirsOnly :: (MonadIO m, FilenameCompleterK a) => a -> -- _obj Bool -> -- dirs_only m () filenameCompleterSetDirsOnly _obj dirs_only = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let dirs_only' = (fromIntegral . fromEnum) dirs_only g_filename_completer_set_dirs_only _obj' dirs_only' touchManagedPtr _obj return () -- signal FilenameCompleter::got-completion-data type FilenameCompleterGotCompletionDataCallback = IO () noFilenameCompleterGotCompletionDataCallback :: Maybe FilenameCompleterGotCompletionDataCallback noFilenameCompleterGotCompletionDataCallback = Nothing type FilenameCompleterGotCompletionDataCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkFilenameCompleterGotCompletionDataCallback :: FilenameCompleterGotCompletionDataCallbackC -> IO (FunPtr FilenameCompleterGotCompletionDataCallbackC) filenameCompleterGotCompletionDataClosure :: FilenameCompleterGotCompletionDataCallback -> IO Closure filenameCompleterGotCompletionDataClosure cb = newCClosure =<< mkFilenameCompleterGotCompletionDataCallback wrapped where wrapped = filenameCompleterGotCompletionDataCallbackWrapper cb filenameCompleterGotCompletionDataCallbackWrapper :: FilenameCompleterGotCompletionDataCallback -> Ptr () -> Ptr () -> IO () filenameCompleterGotCompletionDataCallbackWrapper _cb _ _ = do _cb onFilenameCompleterGotCompletionData :: (GObject a, MonadIO m) => a -> FilenameCompleterGotCompletionDataCallback -> m SignalHandlerId onFilenameCompleterGotCompletionData obj cb = liftIO $ connectFilenameCompleterGotCompletionData obj cb SignalConnectBefore afterFilenameCompleterGotCompletionData :: (GObject a, MonadIO m) => a -> FilenameCompleterGotCompletionDataCallback -> m SignalHandlerId afterFilenameCompleterGotCompletionData obj cb = connectFilenameCompleterGotCompletionData obj cb SignalConnectAfter connectFilenameCompleterGotCompletionData :: (GObject a, MonadIO m) => a -> FilenameCompleterGotCompletionDataCallback -> SignalConnectMode -> m SignalHandlerId connectFilenameCompleterGotCompletionData obj cb after = liftIO $ do cb' <- mkFilenameCompleterGotCompletionDataCallback (filenameCompleterGotCompletionDataCallbackWrapper cb) connectSignalFunPtr obj "got-completion-data" cb' after -- Enum FilesystemPreviewType data FilesystemPreviewType = FilesystemPreviewTypeIfAlways | FilesystemPreviewTypeIfLocal | FilesystemPreviewTypeNever | AnotherFilesystemPreviewType Int deriving (Show, Eq) instance Enum FilesystemPreviewType where fromEnum FilesystemPreviewTypeIfAlways = 0 fromEnum FilesystemPreviewTypeIfLocal = 1 fromEnum FilesystemPreviewTypeNever = 2 fromEnum (AnotherFilesystemPreviewType k) = k toEnum 0 = FilesystemPreviewTypeIfAlways toEnum 1 = FilesystemPreviewTypeIfLocal toEnum 2 = FilesystemPreviewTypeNever toEnum k = AnotherFilesystemPreviewType k foreign import ccall "g_filesystem_preview_type_get_type" c_g_filesystem_preview_type_get_type :: IO GType instance BoxedEnum FilesystemPreviewType where boxedEnumType _ = c_g_filesystem_preview_type_get_type -- object FilterInputStream newtype FilterInputStream = FilterInputStream (ForeignPtr FilterInputStream) noFilterInputStream :: Maybe FilterInputStream noFilterInputStream = Nothing foreign import ccall "g_filter_input_stream_get_type" c_g_filter_input_stream_get_type :: IO GType type instance ParentTypes FilterInputStream = '[InputStream, GObject.Object] instance GObject FilterInputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_filter_input_stream_get_type class GObject o => FilterInputStreamK o instance (GObject o, IsDescendantOf FilterInputStream o) => FilterInputStreamK o toFilterInputStream :: FilterInputStreamK o => o -> IO FilterInputStream toFilterInputStream = unsafeCastTo FilterInputStream -- method FilterInputStream::get_base_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : False -- Skip return : False foreign import ccall "g_filter_input_stream_get_base_stream" g_filter_input_stream_get_base_stream :: Ptr FilterInputStream -> -- _obj : TInterface "Gio" "FilterInputStream" IO (Ptr InputStream) filterInputStreamGetBaseStream :: (MonadIO m, FilterInputStreamK a) => a -> -- _obj m InputStream filterInputStreamGetBaseStream _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_filter_input_stream_get_base_stream _obj' checkUnexpectedReturnNULL "g_filter_input_stream_get_base_stream" result result' <- (newObject InputStream) result touchManagedPtr _obj return result' -- method FilterInputStream::get_close_base_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_filter_input_stream_get_close_base_stream" g_filter_input_stream_get_close_base_stream :: Ptr FilterInputStream -> -- _obj : TInterface "Gio" "FilterInputStream" IO CInt filterInputStreamGetCloseBaseStream :: (MonadIO m, FilterInputStreamK a) => a -> -- _obj m Bool filterInputStreamGetCloseBaseStream _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_filter_input_stream_get_close_base_stream _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FilterInputStream::set_close_base_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_base", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_base", 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_filter_input_stream_set_close_base_stream" g_filter_input_stream_set_close_base_stream :: Ptr FilterInputStream -> -- _obj : TInterface "Gio" "FilterInputStream" CInt -> -- close_base : TBasicType TBoolean IO () filterInputStreamSetCloseBaseStream :: (MonadIO m, FilterInputStreamK a) => a -> -- _obj Bool -> -- close_base m () filterInputStreamSetCloseBaseStream _obj close_base = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let close_base' = (fromIntegral . fromEnum) close_base g_filter_input_stream_set_close_base_stream _obj' close_base' touchManagedPtr _obj return () -- object FilterOutputStream newtype FilterOutputStream = FilterOutputStream (ForeignPtr FilterOutputStream) noFilterOutputStream :: Maybe FilterOutputStream noFilterOutputStream = Nothing foreign import ccall "g_filter_output_stream_get_type" c_g_filter_output_stream_get_type :: IO GType type instance ParentTypes FilterOutputStream = '[OutputStream, GObject.Object] instance GObject FilterOutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_filter_output_stream_get_type class GObject o => FilterOutputStreamK o instance (GObject o, IsDescendantOf FilterOutputStream o) => FilterOutputStreamK o toFilterOutputStream :: FilterOutputStreamK o => o -> IO FilterOutputStream toFilterOutputStream = unsafeCastTo FilterOutputStream -- method FilterOutputStream::get_base_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "OutputStream" -- throws : False -- Skip return : False foreign import ccall "g_filter_output_stream_get_base_stream" g_filter_output_stream_get_base_stream :: Ptr FilterOutputStream -> -- _obj : TInterface "Gio" "FilterOutputStream" IO (Ptr OutputStream) filterOutputStreamGetBaseStream :: (MonadIO m, FilterOutputStreamK a) => a -> -- _obj m OutputStream filterOutputStreamGetBaseStream _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_filter_output_stream_get_base_stream _obj' checkUnexpectedReturnNULL "g_filter_output_stream_get_base_stream" result result' <- (newObject OutputStream) result touchManagedPtr _obj return result' -- method FilterOutputStream::get_close_base_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_filter_output_stream_get_close_base_stream" g_filter_output_stream_get_close_base_stream :: Ptr FilterOutputStream -> -- _obj : TInterface "Gio" "FilterOutputStream" IO CInt filterOutputStreamGetCloseBaseStream :: (MonadIO m, FilterOutputStreamK a) => a -> -- _obj m Bool filterOutputStreamGetCloseBaseStream _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_filter_output_stream_get_close_base_stream _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FilterOutputStream::set_close_base_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_base", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "FilterOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_base", 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_filter_output_stream_set_close_base_stream" g_filter_output_stream_set_close_base_stream :: Ptr FilterOutputStream -> -- _obj : TInterface "Gio" "FilterOutputStream" CInt -> -- close_base : TBasicType TBoolean IO () filterOutputStreamSetCloseBaseStream :: (MonadIO m, FilterOutputStreamK a) => a -> -- _obj Bool -> -- close_base m () filterOutputStreamSetCloseBaseStream _obj close_base = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let close_base' = (fromIntegral . fromEnum) close_base g_filter_output_stream_set_close_base_stream _obj' close_base' touchManagedPtr _obj return () -- Enum IOErrorEnum data IOErrorEnum = IOErrorEnumFailed | IOErrorEnumNotFound | IOErrorEnumExists | IOErrorEnumIsDirectory | IOErrorEnumNotDirectory | IOErrorEnumNotEmpty | IOErrorEnumNotRegularFile | IOErrorEnumNotSymbolicLink | IOErrorEnumNotMountableFile | IOErrorEnumFilenameTooLong | IOErrorEnumInvalidFilename | IOErrorEnumTooManyLinks | IOErrorEnumNoSpace | IOErrorEnumInvalidArgument | IOErrorEnumPermissionDenied | IOErrorEnumNotSupported | IOErrorEnumNotMounted | IOErrorEnumAlreadyMounted | IOErrorEnumClosed | IOErrorEnumCancelled | IOErrorEnumPending | IOErrorEnumReadOnly | IOErrorEnumCantCreateBackup | IOErrorEnumWrongEtag | IOErrorEnumTimedOut | IOErrorEnumWouldRecurse | IOErrorEnumBusy | IOErrorEnumWouldBlock | IOErrorEnumHostNotFound | IOErrorEnumWouldMerge | IOErrorEnumFailedHandled | IOErrorEnumTooManyOpenFiles | IOErrorEnumNotInitialized | IOErrorEnumAddressInUse | IOErrorEnumPartialInput | IOErrorEnumInvalidData | IOErrorEnumDbusError | IOErrorEnumHostUnreachable | IOErrorEnumNetworkUnreachable | IOErrorEnumConnectionRefused | IOErrorEnumProxyFailed | IOErrorEnumProxyAuthFailed | IOErrorEnumProxyNeedAuth | IOErrorEnumProxyNotAllowed | IOErrorEnumBrokenPipe | IOErrorEnumConnectionClosed | IOErrorEnumNotConnected | AnotherIOErrorEnum Int deriving (Show, Eq) instance Enum IOErrorEnum where fromEnum IOErrorEnumFailed = 0 fromEnum IOErrorEnumNotFound = 1 fromEnum IOErrorEnumExists = 2 fromEnum IOErrorEnumIsDirectory = 3 fromEnum IOErrorEnumNotDirectory = 4 fromEnum IOErrorEnumNotEmpty = 5 fromEnum IOErrorEnumNotRegularFile = 6 fromEnum IOErrorEnumNotSymbolicLink = 7 fromEnum IOErrorEnumNotMountableFile = 8 fromEnum IOErrorEnumFilenameTooLong = 9 fromEnum IOErrorEnumInvalidFilename = 10 fromEnum IOErrorEnumTooManyLinks = 11 fromEnum IOErrorEnumNoSpace = 12 fromEnum IOErrorEnumInvalidArgument = 13 fromEnum IOErrorEnumPermissionDenied = 14 fromEnum IOErrorEnumNotSupported = 15 fromEnum IOErrorEnumNotMounted = 16 fromEnum IOErrorEnumAlreadyMounted = 17 fromEnum IOErrorEnumClosed = 18 fromEnum IOErrorEnumCancelled = 19 fromEnum IOErrorEnumPending = 20 fromEnum IOErrorEnumReadOnly = 21 fromEnum IOErrorEnumCantCreateBackup = 22 fromEnum IOErrorEnumWrongEtag = 23 fromEnum IOErrorEnumTimedOut = 24 fromEnum IOErrorEnumWouldRecurse = 25 fromEnum IOErrorEnumBusy = 26 fromEnum IOErrorEnumWouldBlock = 27 fromEnum IOErrorEnumHostNotFound = 28 fromEnum IOErrorEnumWouldMerge = 29 fromEnum IOErrorEnumFailedHandled = 30 fromEnum IOErrorEnumTooManyOpenFiles = 31 fromEnum IOErrorEnumNotInitialized = 32 fromEnum IOErrorEnumAddressInUse = 33 fromEnum IOErrorEnumPartialInput = 34 fromEnum IOErrorEnumInvalidData = 35 fromEnum IOErrorEnumDbusError = 36 fromEnum IOErrorEnumHostUnreachable = 37 fromEnum IOErrorEnumNetworkUnreachable = 38 fromEnum IOErrorEnumConnectionRefused = 39 fromEnum IOErrorEnumProxyFailed = 40 fromEnum IOErrorEnumProxyAuthFailed = 41 fromEnum IOErrorEnumProxyNeedAuth = 42 fromEnum IOErrorEnumProxyNotAllowed = 43 fromEnum IOErrorEnumBrokenPipe = 44 fromEnum IOErrorEnumConnectionClosed = 44 fromEnum IOErrorEnumNotConnected = 45 fromEnum (AnotherIOErrorEnum k) = k toEnum 0 = IOErrorEnumFailed toEnum 1 = IOErrorEnumNotFound toEnum 2 = IOErrorEnumExists toEnum 3 = IOErrorEnumIsDirectory toEnum 4 = IOErrorEnumNotDirectory toEnum 5 = IOErrorEnumNotEmpty toEnum 6 = IOErrorEnumNotRegularFile toEnum 7 = IOErrorEnumNotSymbolicLink toEnum 8 = IOErrorEnumNotMountableFile toEnum 9 = IOErrorEnumFilenameTooLong toEnum 10 = IOErrorEnumInvalidFilename toEnum 11 = IOErrorEnumTooManyLinks toEnum 12 = IOErrorEnumNoSpace toEnum 13 = IOErrorEnumInvalidArgument toEnum 14 = IOErrorEnumPermissionDenied toEnum 15 = IOErrorEnumNotSupported toEnum 16 = IOErrorEnumNotMounted toEnum 17 = IOErrorEnumAlreadyMounted toEnum 18 = IOErrorEnumClosed toEnum 19 = IOErrorEnumCancelled toEnum 20 = IOErrorEnumPending toEnum 21 = IOErrorEnumReadOnly toEnum 22 = IOErrorEnumCantCreateBackup toEnum 23 = IOErrorEnumWrongEtag toEnum 24 = IOErrorEnumTimedOut toEnum 25 = IOErrorEnumWouldRecurse toEnum 26 = IOErrorEnumBusy toEnum 27 = IOErrorEnumWouldBlock toEnum 28 = IOErrorEnumHostNotFound toEnum 29 = IOErrorEnumWouldMerge toEnum 30 = IOErrorEnumFailedHandled toEnum 31 = IOErrorEnumTooManyOpenFiles toEnum 32 = IOErrorEnumNotInitialized toEnum 33 = IOErrorEnumAddressInUse toEnum 34 = IOErrorEnumPartialInput toEnum 35 = IOErrorEnumInvalidData toEnum 36 = IOErrorEnumDbusError toEnum 37 = IOErrorEnumHostUnreachable toEnum 38 = IOErrorEnumNetworkUnreachable toEnum 39 = IOErrorEnumConnectionRefused toEnum 40 = IOErrorEnumProxyFailed toEnum 41 = IOErrorEnumProxyAuthFailed toEnum 42 = IOErrorEnumProxyNeedAuth toEnum 43 = IOErrorEnumProxyNotAllowed toEnum 44 = IOErrorEnumBrokenPipe toEnum 45 = IOErrorEnumNotConnected toEnum k = AnotherIOErrorEnum k instance GErrorClass IOErrorEnum where gerrorClassDomain _ = "g-io-error-quark" catchIOErrorEnum :: IO a -> (IOErrorEnum -> GErrorMessage -> IO a) -> IO a catchIOErrorEnum = catchGErrorJustDomain handleIOErrorEnum :: (IOErrorEnum -> GErrorMessage -> IO a) -> IO a -> IO a handleIOErrorEnum = handleGErrorJustDomain foreign import ccall "g_io_error_enum_get_type" c_g_io_error_enum_get_type :: IO GType instance BoxedEnum IOErrorEnum where boxedEnumType _ = c_g_io_error_enum_get_type -- struct IOExtension newtype IOExtension = IOExtension (ForeignPtr IOExtension) noIOExtension :: Maybe IOExtension noIOExtension = Nothing -- method IOExtension::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtension", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtension", 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_extension_get_name" g_io_extension_get_name :: Ptr IOExtension -> -- _obj : TInterface "Gio" "IOExtension" IO CString iOExtensionGetName :: (MonadIO m) => IOExtension -> -- _obj m T.Text iOExtensionGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_extension_get_name _obj' checkUnexpectedReturnNULL "g_io_extension_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method IOExtension::get_priority -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtension", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtension", 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_extension_get_priority" g_io_extension_get_priority :: Ptr IOExtension -> -- _obj : TInterface "Gio" "IOExtension" IO Int32 iOExtensionGetPriority :: (MonadIO m) => IOExtension -> -- _obj m Int32 iOExtensionGetPriority _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_extension_get_priority _obj' touchManagedPtr _obj return result -- method IOExtension::get_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtension", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtension", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_io_extension_get_type" g_io_extension_get_type :: Ptr IOExtension -> -- _obj : TInterface "Gio" "IOExtension" IO CGType iOExtensionGetType :: (MonadIO m) => IOExtension -> -- _obj m GType iOExtensionGetType _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_extension_get_type _obj' let result' = GType result touchManagedPtr _obj return result' -- struct IOExtensionPoint newtype IOExtensionPoint = IOExtensionPoint (ForeignPtr IOExtensionPoint) noIOExtensionPoint :: Maybe IOExtensionPoint noIOExtensionPoint = Nothing -- method IOExtensionPoint::get_extension_by_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtensionPoint", 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 "Gio" "IOExtensionPoint", 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 : TInterface "Gio" "IOExtension" -- throws : False -- Skip return : False foreign import ccall "g_io_extension_point_get_extension_by_name" g_io_extension_point_get_extension_by_name :: Ptr IOExtensionPoint -> -- _obj : TInterface "Gio" "IOExtensionPoint" CString -> -- name : TBasicType TUTF8 IO (Ptr IOExtension) iOExtensionPointGetExtensionByName :: (MonadIO m) => IOExtensionPoint -> -- _obj T.Text -> -- name m IOExtension iOExtensionPointGetExtensionByName _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_io_extension_point_get_extension_by_name _obj' name' checkUnexpectedReturnNULL "g_io_extension_point_get_extension_by_name" result -- XXX Wrapping a foreign struct/union with no known destructor, leak? result' <- (\x -> IOExtension <$> newForeignPtr_ x) result touchManagedPtr _obj freeMem name' return result' -- method IOExtensionPoint::get_extensions -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtensionPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtensionPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "IOExtension") -- throws : False -- Skip return : False foreign import ccall "g_io_extension_point_get_extensions" g_io_extension_point_get_extensions :: Ptr IOExtensionPoint -> -- _obj : TInterface "Gio" "IOExtensionPoint" IO (Ptr (GList (Ptr IOExtension))) iOExtensionPointGetExtensions :: (MonadIO m) => IOExtensionPoint -> -- _obj m [IOExtension] iOExtensionPointGetExtensions _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_extension_point_get_extensions _obj' checkUnexpectedReturnNULL "g_io_extension_point_get_extensions" result -- XXX Wrapping a foreign struct/union with no known destructor, leak? result' <- unpackGList result result'' <- mapM (\x -> IOExtension <$> newForeignPtr_ x) result' touchManagedPtr _obj return result'' -- method IOExtensionPoint::get_required_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtensionPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtensionPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_io_extension_point_get_required_type" g_io_extension_point_get_required_type :: Ptr IOExtensionPoint -> -- _obj : TInterface "Gio" "IOExtensionPoint" IO CGType iOExtensionPointGetRequiredType :: (MonadIO m) => IOExtensionPoint -> -- _obj m GType iOExtensionPointGetRequiredType _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_io_extension_point_get_required_type _obj' let result' = GType result touchManagedPtr _obj return result' -- method IOExtensionPoint::set_required_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtensionPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOExtensionPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TGType, 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_extension_point_set_required_type" g_io_extension_point_set_required_type :: Ptr IOExtensionPoint -> -- _obj : TInterface "Gio" "IOExtensionPoint" CGType -> -- type : TBasicType TGType IO () iOExtensionPointSetRequiredType :: (MonadIO m) => IOExtensionPoint -> -- _obj GType -> -- type m () iOExtensionPointSetRequiredType _obj type_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let type_' = gtypeToCGType type_ g_io_extension_point_set_required_type _obj' type_' touchManagedPtr _obj return () -- struct IOModuleScope newtype IOModuleScope = IOModuleScope (ForeignPtr IOModuleScope) noIOModuleScope :: Maybe IOModuleScope noIOModuleScope = Nothing -- method IOModuleScope::block -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOModuleScope", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "basename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOModuleScope", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "basename", 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_io_module_scope_block" g_io_module_scope_block :: Ptr IOModuleScope -> -- _obj : TInterface "Gio" "IOModuleScope" CString -> -- basename : TBasicType TUTF8 IO () iOModuleScopeBlock :: (MonadIO m) => IOModuleScope -> -- _obj T.Text -> -- basename m () iOModuleScopeBlock _obj basename = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj basename' <- textToCString basename g_io_module_scope_block _obj' basename' touchManagedPtr _obj freeMem basename' return () -- method IOModuleScope::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOModuleScope", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOModuleScope", 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_module_scope_free" g_io_module_scope_free :: Ptr IOModuleScope -> -- _obj : TInterface "Gio" "IOModuleScope" IO () iOModuleScopeFree :: (MonadIO m) => IOModuleScope -> -- _obj m () iOModuleScopeFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_io_module_scope_free _obj' touchManagedPtr _obj return () -- Enum IOModuleScopeFlags data IOModuleScopeFlags = IOModuleScopeFlagsNone | IOModuleScopeFlagsBlockDuplicates | AnotherIOModuleScopeFlags Int deriving (Show, Eq) instance Enum IOModuleScopeFlags where fromEnum IOModuleScopeFlagsNone = 0 fromEnum IOModuleScopeFlagsBlockDuplicates = 1 fromEnum (AnotherIOModuleScopeFlags k) = k toEnum 0 = IOModuleScopeFlagsNone toEnum 1 = IOModuleScopeFlagsBlockDuplicates toEnum k = AnotherIOModuleScopeFlags k foreign import ccall "g_io_module_scope_flags_get_type" c_g_io_module_scope_flags_get_type :: IO GType instance BoxedEnum IOModuleScopeFlags where boxedEnumType _ = c_g_io_module_scope_flags_get_type -- struct IOSchedulerJob newtype IOSchedulerJob = IOSchedulerJob (ForeignPtr IOSchedulerJob) noIOSchedulerJob :: Maybe IOSchedulerJob noIOSchedulerJob = Nothing -- method IOSchedulerJob::send_to_mainloop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOSchedulerJob", 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 = "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 = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOSchedulerJob", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_io_scheduler_job_send_to_mainloop" g_io_scheduler_job_send_to_mainloop :: Ptr IOSchedulerJob -> -- _obj : TInterface "Gio" "IOSchedulerJob" FunPtr GLib.SourceFuncC -> -- func : TInterface "GLib" "SourceFunc" Ptr () -> -- user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO CInt {-# DEPRECATED iOSchedulerJobSendToMainloop ["Use g_main_context_invoke()."]#-} iOSchedulerJobSendToMainloop :: (MonadIO m) => IOSchedulerJob -> -- _obj GLib.SourceFunc -> -- func m Bool iOSchedulerJobSendToMainloop _obj func = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj func' <- GLib.mkSourceFunc (GLib.sourceFuncWrapper Nothing func) let user_data = castFunPtrToPtr func' let notify = safeFreeFunPtrPtr result <- g_io_scheduler_job_send_to_mainloop _obj' func' user_data notify let result' = (/= 0) result touchManagedPtr _obj return result' -- method IOSchedulerJob::send_to_mainloop_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOSchedulerJob", 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 = "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 = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOSchedulerJob", 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_io_scheduler_job_send_to_mainloop_async" g_io_scheduler_job_send_to_mainloop_async :: Ptr IOSchedulerJob -> -- _obj : TInterface "Gio" "IOSchedulerJob" FunPtr GLib.SourceFuncC -> -- func : TInterface "GLib" "SourceFunc" Ptr () -> -- user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" IO () {-# DEPRECATED iOSchedulerJobSendToMainloopAsync ["Use g_main_context_invoke()."]#-} iOSchedulerJobSendToMainloopAsync :: (MonadIO m) => IOSchedulerJob -> -- _obj GLib.SourceFunc -> -- func m () iOSchedulerJobSendToMainloopAsync _obj func = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj func' <- GLib.mkSourceFunc (GLib.sourceFuncWrapper Nothing func) let user_data = castFunPtrToPtr func' let notify = safeFreeFunPtrPtr g_io_scheduler_job_send_to_mainloop_async _obj' func' user_data notify touchManagedPtr _obj return () -- callback IOSchedulerJobFunc iOSchedulerJobFuncClosure :: IOSchedulerJobFunc -> IO Closure iOSchedulerJobFuncClosure cb = newCClosure =<< mkIOSchedulerJobFunc wrapped where wrapped = iOSchedulerJobFuncWrapper Nothing cb type IOSchedulerJobFuncC = Ptr IOSchedulerJob -> Ptr Cancellable -> Ptr () -> IO CInt foreign import ccall "wrapper" mkIOSchedulerJobFunc :: IOSchedulerJobFuncC -> IO (FunPtr IOSchedulerJobFuncC) type IOSchedulerJobFunc = IOSchedulerJob -> Maybe Cancellable -> IO Bool noIOSchedulerJobFunc :: Maybe IOSchedulerJobFunc noIOSchedulerJobFunc = Nothing iOSchedulerJobFuncWrapper :: Maybe (Ptr (FunPtr (IOSchedulerJobFuncC))) -> IOSchedulerJobFunc -> Ptr IOSchedulerJob -> Ptr Cancellable -> Ptr () -> IO CInt iOSchedulerJobFuncWrapper funptrptr _cb job cancellable _ = do -- XXX Wrapping a foreign struct/union with no known destructor, leak? job' <- (\x -> IOSchedulerJob <$> newForeignPtr_ x) job maybeCancellable <- if cancellable == nullPtr then return Nothing else do cancellable' <- (newObject Cancellable) cancellable return $ Just cancellable' result <- _cb job' maybeCancellable maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- object IOStream newtype IOStream = IOStream (ForeignPtr IOStream) noIOStream :: Maybe IOStream noIOStream = Nothing foreign import ccall "g_io_stream_get_type" c_g_io_stream_get_type :: IO GType type instance ParentTypes IOStream = '[GObject.Object] instance GObject IOStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_io_stream_get_type class GObject o => IOStreamK o instance (GObject o, IsDescendantOf IOStream o) => IOStreamK o toIOStream :: IOStreamK o => o -> IO IOStream toIOStream = unsafeCastTo IOStream -- method IOStream::clear_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", 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_stream_clear_pending" g_io_stream_clear_pending :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" IO () iOStreamClearPending :: (MonadIO m, IOStreamK a) => a -> -- _obj m () iOStreamClearPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_io_stream_clear_pending _obj' touchManagedPtr _obj return () -- method IOStream::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_io_stream_close" g_io_stream_close :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt iOStreamClose :: (MonadIO m, IOStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () iOStreamClose _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_io_stream_close _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method IOStream::close_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_stream_close_async" g_io_stream_close_async :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () iOStreamCloseAsync :: (MonadIO m, IOStreamK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () iOStreamCloseAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_io_stream_close_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method IOStream::close_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_io_stream_close_finish" g_io_stream_close_finish :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt iOStreamCloseFinish :: (MonadIO m, IOStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m () iOStreamCloseFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_io_stream_close_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method IOStream::get_input_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : False -- Skip return : False foreign import ccall "g_io_stream_get_input_stream" g_io_stream_get_input_stream :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" IO (Ptr InputStream) iOStreamGetInputStream :: (MonadIO m, IOStreamK a) => a -> -- _obj m InputStream iOStreamGetInputStream _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_io_stream_get_input_stream _obj' checkUnexpectedReturnNULL "g_io_stream_get_input_stream" result result' <- (newObject InputStream) result touchManagedPtr _obj return result' -- method IOStream::get_output_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "OutputStream" -- throws : False -- Skip return : False foreign import ccall "g_io_stream_get_output_stream" g_io_stream_get_output_stream :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" IO (Ptr OutputStream) iOStreamGetOutputStream :: (MonadIO m, IOStreamK a) => a -> -- _obj m OutputStream iOStreamGetOutputStream _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_io_stream_get_output_stream _obj' checkUnexpectedReturnNULL "g_io_stream_get_output_stream" result result' <- (newObject OutputStream) result touchManagedPtr _obj return result' -- method IOStream::has_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", 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_stream_has_pending" g_io_stream_has_pending :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" IO CInt iOStreamHasPending :: (MonadIO m, IOStreamK a) => a -> -- _obj m Bool iOStreamHasPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_io_stream_has_pending _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method IOStream::is_closed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", 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_stream_is_closed" g_io_stream_is_closed :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" IO CInt iOStreamIsClosed :: (MonadIO m, IOStreamK a) => a -> -- _obj m Bool iOStreamIsClosed _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_io_stream_is_closed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method IOStream::set_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_io_stream_set_pending" g_io_stream_set_pending :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" Ptr (Ptr GError) -> -- error IO CInt iOStreamSetPending :: (MonadIO m, IOStreamK a) => a -> -- _obj m () iOStreamSetPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_io_stream_set_pending _obj' touchManagedPtr _obj return () ) (do return () ) -- method IOStream::splice_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stream2", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "IOStreamSpliceFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stream2", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "IOStreamSpliceFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_stream_splice_async" g_io_stream_splice_async :: Ptr IOStream -> -- _obj : TInterface "Gio" "IOStream" Ptr IOStream -> -- stream2 : TInterface "Gio" "IOStream" CUInt -> -- flags : TInterface "Gio" "IOStreamSpliceFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () iOStreamSpliceAsync :: (MonadIO m, IOStreamK a, IOStreamK b, CancellableK c) => a -> -- _obj b -> -- stream2 [IOStreamSpliceFlags] -> -- flags Int32 -> -- io_priority Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () iOStreamSpliceAsync _obj stream2 flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let stream2' = unsafeManagedPtrCastPtr stream2 let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_io_stream_splice_async _obj' stream2' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr stream2 whenJust cancellable touchManagedPtr return () -- method IOStream::splice_finish -- method type : MemberFunction -- Args : [Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_io_stream_splice_finish" g_io_stream_splice_finish :: Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt iOStreamSpliceFinish :: (MonadIO m, AsyncResultK a) => a -> -- result m () iOStreamSpliceFinish result_ = liftIO $ do let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_io_stream_splice_finish result_' touchManagedPtr result_ return () ) (do return () ) -- struct IOStreamAdapter newtype IOStreamAdapter = IOStreamAdapter (ForeignPtr IOStreamAdapter) noIOStreamAdapter :: Maybe IOStreamAdapter noIOStreamAdapter = Nothing -- Flags IOStreamSpliceFlags data IOStreamSpliceFlags = IOStreamSpliceFlagsNone | IOStreamSpliceFlagsCloseStream1 | IOStreamSpliceFlagsCloseStream2 | IOStreamSpliceFlagsWaitForBoth | AnotherIOStreamSpliceFlags Int deriving (Show, Eq) instance Enum IOStreamSpliceFlags where fromEnum IOStreamSpliceFlagsNone = 0 fromEnum IOStreamSpliceFlagsCloseStream1 = 1 fromEnum IOStreamSpliceFlagsCloseStream2 = 2 fromEnum IOStreamSpliceFlagsWaitForBoth = 4 fromEnum (AnotherIOStreamSpliceFlags k) = k toEnum 0 = IOStreamSpliceFlagsNone toEnum 1 = IOStreamSpliceFlagsCloseStream1 toEnum 2 = IOStreamSpliceFlagsCloseStream2 toEnum 4 = IOStreamSpliceFlagsWaitForBoth toEnum k = AnotherIOStreamSpliceFlags k foreign import ccall "g_io_stream_splice_flags_get_type" c_g_io_stream_splice_flags_get_type :: IO GType instance BoxedEnum IOStreamSpliceFlags where boxedEnumType _ = c_g_io_stream_splice_flags_get_type instance IsGFlag IOStreamSpliceFlags -- interface Icon newtype Icon = Icon (ForeignPtr Icon) noIcon :: Maybe Icon noIcon = Nothing foreign import ccall "g_icon_get_type" c_g_icon_get_type :: IO GType type instance ParentTypes Icon = '[GObject.Object] instance GObject Icon where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_icon_get_type class GObject o => IconK o instance (GObject o, IsDescendantOf Icon o) => IconK o toIcon :: IconK o => o -> IO Icon toIcon = unsafeCastTo Icon -- method Icon::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon2", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon2", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_icon_equal" g_icon_equal :: Ptr Icon -> -- _obj : TInterface "Gio" "Icon" Ptr Icon -> -- icon2 : TInterface "Gio" "Icon" IO CInt iconEqual :: (MonadIO m, IconK a, IconK b) => a -> -- _obj Maybe (b) -> -- icon2 m Bool iconEqual _obj icon2 = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeIcon2 <- case icon2 of Nothing -> return nullPtr Just jIcon2 -> do let jIcon2' = unsafeManagedPtrCastPtr jIcon2 return jIcon2' result <- g_icon_equal _obj' maybeIcon2 let result' = (/= 0) result touchManagedPtr _obj whenJust icon2 touchManagedPtr return result' -- method Icon::serialize -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_icon_serialize" g_icon_serialize :: Ptr Icon -> -- _obj : TInterface "Gio" "Icon" IO (Ptr GVariant) iconSerialize :: (MonadIO m, IconK a) => a -> -- _obj m GVariant iconSerialize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_icon_serialize _obj' checkUnexpectedReturnNULL "g_icon_serialize" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method Icon::to_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_icon_to_string" g_icon_to_string :: Ptr Icon -> -- _obj : TInterface "Gio" "Icon" IO CString iconToString :: (MonadIO m, IconK a) => a -> -- _obj m T.Text iconToString _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_icon_to_string _obj' checkUnexpectedReturnNULL "g_icon_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- object InetAddress newtype InetAddress = InetAddress (ForeignPtr InetAddress) noInetAddress :: Maybe InetAddress noInetAddress = Nothing foreign import ccall "g_inet_address_get_type" c_g_inet_address_get_type :: IO GType type instance ParentTypes InetAddress = '[GObject.Object] instance GObject InetAddress where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_inet_address_get_type class GObject o => InetAddressK o instance (GObject o, IsDescendantOf InetAddress o) => InetAddressK o toInetAddress :: InetAddressK o => o -> IO InetAddress toInetAddress = unsafeCastTo InetAddress -- method InetAddress::new_any -- method type : Constructor -- Args : [Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetAddress" -- throws : False -- Skip return : False foreign import ccall "g_inet_address_new_any" g_inet_address_new_any :: CUInt -> -- family : TInterface "Gio" "SocketFamily" IO (Ptr InetAddress) inetAddressNewAny :: (MonadIO m) => SocketFamily -> -- family m InetAddress inetAddressNewAny family = liftIO $ do let family' = (fromIntegral . fromEnum) family result <- g_inet_address_new_any family' checkUnexpectedReturnNULL "g_inet_address_new_any" result result' <- (wrapObject InetAddress) result return result' -- method InetAddress::new_from_bytes -- method type : Constructor -- Args : [Arg {argName = "bytes", argType = TCArray False (-1) (-1) (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bytes", argType = TCArray False (-1) (-1) (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetAddress" -- throws : False -- Skip return : False foreign import ccall "g_inet_address_new_from_bytes" g_inet_address_new_from_bytes :: Ptr Word8 -> -- bytes : TCArray False (-1) (-1) (TBasicType TUInt8) CUInt -> -- family : TInterface "Gio" "SocketFamily" IO (Ptr InetAddress) inetAddressNewFromBytes :: (MonadIO m) => Ptr Word8 -> -- bytes SocketFamily -> -- family m InetAddress inetAddressNewFromBytes bytes family = liftIO $ do let family' = (fromIntegral . fromEnum) family result <- g_inet_address_new_from_bytes bytes family' checkUnexpectedReturnNULL "g_inet_address_new_from_bytes" result result' <- (wrapObject InetAddress) result return result' -- method InetAddress::new_from_string -- method type : Constructor -- 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 : TInterface "Gio" "InetAddress" -- throws : False -- Skip return : False foreign import ccall "g_inet_address_new_from_string" g_inet_address_new_from_string :: CString -> -- string : TBasicType TUTF8 IO (Ptr InetAddress) inetAddressNewFromString :: (MonadIO m) => T.Text -> -- string m InetAddress inetAddressNewFromString string = liftIO $ do string' <- textToCString string result <- g_inet_address_new_from_string string' checkUnexpectedReturnNULL "g_inet_address_new_from_string" result result' <- (wrapObject InetAddress) result freeMem string' return result' -- method InetAddress::new_loopback -- method type : Constructor -- Args : [Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetAddress" -- throws : False -- Skip return : False foreign import ccall "g_inet_address_new_loopback" g_inet_address_new_loopback :: CUInt -> -- family : TInterface "Gio" "SocketFamily" IO (Ptr InetAddress) inetAddressNewLoopback :: (MonadIO m) => SocketFamily -> -- family m InetAddress inetAddressNewLoopback family = liftIO $ do let family' = (fromIntegral . fromEnum) family result <- g_inet_address_new_loopback family' checkUnexpectedReturnNULL "g_inet_address_new_loopback" result result' <- (wrapObject InetAddress) result return result' -- method InetAddress::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other_address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other_address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_equal" g_inet_address_equal :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" Ptr InetAddress -> -- other_address : TInterface "Gio" "InetAddress" IO CInt inetAddressEqual :: (MonadIO m, InetAddressK a, InetAddressK b) => a -> -- _obj b -> -- other_address m Bool inetAddressEqual _obj other_address = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let other_address' = unsafeManagedPtrCastPtr other_address result <- g_inet_address_equal _obj' other_address' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr other_address return result' -- method InetAddress::get_family -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketFamily" -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_family" g_inet_address_get_family :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CUInt inetAddressGetFamily :: (MonadIO m, InetAddressK a) => a -> -- _obj m SocketFamily inetAddressGetFamily _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_family _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method InetAddress::get_is_any -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_any" g_inet_address_get_is_any :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsAny :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsAny _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_any _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_link_local -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_link_local" g_inet_address_get_is_link_local :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsLinkLocal :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsLinkLocal _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_link_local _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_loopback -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_loopback" g_inet_address_get_is_loopback :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsLoopback :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsLoopback _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_loopback _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_mc_global -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_mc_global" g_inet_address_get_is_mc_global :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsMcGlobal :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsMcGlobal _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_mc_global _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_mc_link_local -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_mc_link_local" g_inet_address_get_is_mc_link_local :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsMcLinkLocal :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsMcLinkLocal _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_mc_link_local _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_mc_node_local -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_mc_node_local" g_inet_address_get_is_mc_node_local :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsMcNodeLocal :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsMcNodeLocal _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_mc_node_local _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_mc_org_local -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_mc_org_local" g_inet_address_get_is_mc_org_local :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsMcOrgLocal :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsMcOrgLocal _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_mc_org_local _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_mc_site_local -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_mc_site_local" g_inet_address_get_is_mc_site_local :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsMcSiteLocal :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsMcSiteLocal _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_mc_site_local _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_multicast -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_multicast" g_inet_address_get_is_multicast :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsMulticast :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsMulticast _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_multicast _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_is_site_local -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_is_site_local" g_inet_address_get_is_site_local :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CInt inetAddressGetIsSiteLocal :: (MonadIO m, InetAddressK a) => a -> -- _obj m Bool inetAddressGetIsSiteLocal _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_is_site_local _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InetAddress::get_native_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_inet_address_get_native_size" g_inet_address_get_native_size :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO Word64 inetAddressGetNativeSize :: (MonadIO m, InetAddressK a) => a -> -- _obj m Word64 inetAddressGetNativeSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_get_native_size _obj' touchManagedPtr _obj return result -- method InetAddress::to_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_inet_address_to_string" g_inet_address_to_string :: Ptr InetAddress -> -- _obj : TInterface "Gio" "InetAddress" IO CString inetAddressToString :: (MonadIO m, InetAddressK a) => a -> -- _obj m T.Text inetAddressToString _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_to_string _obj' checkUnexpectedReturnNULL "g_inet_address_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- object InetAddressMask newtype InetAddressMask = InetAddressMask (ForeignPtr InetAddressMask) noInetAddressMask :: Maybe InetAddressMask noInetAddressMask = Nothing foreign import ccall "g_inet_address_mask_get_type" c_g_inet_address_mask_get_type :: IO GType type instance ParentTypes InetAddressMask = '[GObject.Object, Initable] instance GObject InetAddressMask where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_inet_address_mask_get_type class GObject o => InetAddressMaskK o instance (GObject o, IsDescendantOf InetAddressMask o) => InetAddressMaskK o toInetAddressMask :: InetAddressMaskK o => o -> IO InetAddressMask toInetAddressMask = unsafeCastTo InetAddressMask -- method InetAddressMask::new -- method type : Constructor -- Args : [Arg {argName = "addr", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "addr", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetAddressMask" -- throws : True -- Skip return : False foreign import ccall "g_inet_address_mask_new" g_inet_address_mask_new :: Ptr InetAddress -> -- addr : TInterface "Gio" "InetAddress" Word32 -> -- length : TBasicType TUInt32 Ptr (Ptr GError) -> -- error IO (Ptr InetAddressMask) inetAddressMaskNew :: (MonadIO m, InetAddressK a) => a -> -- addr Word32 -> -- length m InetAddressMask inetAddressMaskNew addr length_ = liftIO $ do let addr' = unsafeManagedPtrCastPtr addr onException (do result <- propagateGError $ g_inet_address_mask_new addr' length_ checkUnexpectedReturnNULL "g_inet_address_mask_new" result result' <- (wrapObject InetAddressMask) result touchManagedPtr addr return result' ) (do return () ) -- method InetAddressMask::new_from_string -- method type : Constructor -- Args : [Arg {argName = "mask_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mask_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetAddressMask" -- throws : True -- Skip return : False foreign import ccall "g_inet_address_mask_new_from_string" g_inet_address_mask_new_from_string :: CString -> -- mask_string : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr InetAddressMask) inetAddressMaskNewFromString :: (MonadIO m) => T.Text -> -- mask_string m InetAddressMask inetAddressMaskNewFromString mask_string = liftIO $ do mask_string' <- textToCString mask_string onException (do result <- propagateGError $ g_inet_address_mask_new_from_string mask_string' checkUnexpectedReturnNULL "g_inet_address_mask_new_from_string" result result' <- (wrapObject InetAddressMask) result freeMem mask_string' return result' ) (do freeMem mask_string' ) -- method InetAddressMask::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask2", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask2", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_mask_equal" g_inet_address_mask_equal :: Ptr InetAddressMask -> -- _obj : TInterface "Gio" "InetAddressMask" Ptr InetAddressMask -> -- mask2 : TInterface "Gio" "InetAddressMask" IO CInt inetAddressMaskEqual :: (MonadIO m, InetAddressMaskK a, InetAddressMaskK b) => a -> -- _obj b -> -- mask2 m Bool inetAddressMaskEqual _obj mask2 = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let mask2' = unsafeManagedPtrCastPtr mask2 result <- g_inet_address_mask_equal _obj' mask2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr mask2 return result' -- method InetAddressMask::get_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetAddress" -- throws : False -- Skip return : False foreign import ccall "g_inet_address_mask_get_address" g_inet_address_mask_get_address :: Ptr InetAddressMask -> -- _obj : TInterface "Gio" "InetAddressMask" IO (Ptr InetAddress) inetAddressMaskGetAddress :: (MonadIO m, InetAddressMaskK a) => a -> -- _obj m InetAddress inetAddressMaskGetAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_mask_get_address _obj' checkUnexpectedReturnNULL "g_inet_address_mask_get_address" result result' <- (newObject InetAddress) result touchManagedPtr _obj return result' -- method InetAddressMask::get_family -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketFamily" -- throws : False -- Skip return : False foreign import ccall "g_inet_address_mask_get_family" g_inet_address_mask_get_family :: Ptr InetAddressMask -> -- _obj : TInterface "Gio" "InetAddressMask" IO CUInt inetAddressMaskGetFamily :: (MonadIO m, InetAddressMaskK a) => a -> -- _obj m SocketFamily inetAddressMaskGetFamily _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_mask_get_family _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method InetAddressMask::get_length -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_inet_address_mask_get_length" g_inet_address_mask_get_length :: Ptr InetAddressMask -> -- _obj : TInterface "Gio" "InetAddressMask" IO Word32 inetAddressMaskGetLength :: (MonadIO m, InetAddressMaskK a) => a -> -- _obj m Word32 inetAddressMaskGetLength _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_mask_get_length _obj' touchManagedPtr _obj return result -- method InetAddressMask::matches -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_inet_address_mask_matches" g_inet_address_mask_matches :: Ptr InetAddressMask -> -- _obj : TInterface "Gio" "InetAddressMask" Ptr InetAddress -> -- address : TInterface "Gio" "InetAddress" IO CInt inetAddressMaskMatches :: (MonadIO m, InetAddressMaskK a, InetAddressK b) => a -> -- _obj b -> -- address m Bool inetAddressMaskMatches _obj address = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let address' = unsafeManagedPtrCastPtr address result <- g_inet_address_mask_matches _obj' address' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr address return result' -- method InetAddressMask::to_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetAddressMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_inet_address_mask_to_string" g_inet_address_mask_to_string :: Ptr InetAddressMask -> -- _obj : TInterface "Gio" "InetAddressMask" IO CString inetAddressMaskToString :: (MonadIO m, InetAddressMaskK a) => a -> -- _obj m T.Text inetAddressMaskToString _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_address_mask_to_string _obj' checkUnexpectedReturnNULL "g_inet_address_mask_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- object InetSocketAddress newtype InetSocketAddress = InetSocketAddress (ForeignPtr InetSocketAddress) noInetSocketAddress :: Maybe InetSocketAddress noInetSocketAddress = Nothing foreign import ccall "g_inet_socket_address_get_type" c_g_inet_socket_address_get_type :: IO GType type instance ParentTypes InetSocketAddress = '[SocketAddress, GObject.Object, SocketConnectable] instance GObject InetSocketAddress where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_inet_socket_address_get_type class GObject o => InetSocketAddressK o instance (GObject o, IsDescendantOf InetSocketAddress o) => InetSocketAddressK o toInetSocketAddress :: InetSocketAddressK o => o -> IO InetSocketAddress toInetSocketAddress = unsafeCastTo InetSocketAddress -- method InetSocketAddress::new -- method type : Constructor -- Args : [Arg {argName = "address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetSocketAddress" -- throws : False -- Skip return : False foreign import ccall "g_inet_socket_address_new" g_inet_socket_address_new :: Ptr InetAddress -> -- address : TInterface "Gio" "InetAddress" Word16 -> -- port : TBasicType TUInt16 IO (Ptr InetSocketAddress) inetSocketAddressNew :: (MonadIO m, InetAddressK a) => a -> -- address Word16 -> -- port m InetSocketAddress inetSocketAddressNew address port = liftIO $ do let address' = unsafeManagedPtrCastPtr address result <- g_inet_socket_address_new address' port checkUnexpectedReturnNULL "g_inet_socket_address_new" result result' <- (wrapObject InetSocketAddress) result touchManagedPtr address return result' -- method InetSocketAddress::new_from_string -- method type : Constructor -- Args : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetSocketAddress" -- throws : False -- Skip return : False foreign import ccall "g_inet_socket_address_new_from_string" g_inet_socket_address_new_from_string :: CString -> -- address : TBasicType TUTF8 Word32 -> -- port : TBasicType TUInt32 IO (Ptr InetSocketAddress) inetSocketAddressNewFromString :: (MonadIO m) => T.Text -> -- address Word32 -> -- port m InetSocketAddress inetSocketAddressNewFromString address port = liftIO $ do address' <- textToCString address result <- g_inet_socket_address_new_from_string address' port checkUnexpectedReturnNULL "g_inet_socket_address_new_from_string" result result' <- (wrapObject InetSocketAddress) result freeMem address' return result' -- method InetSocketAddress::get_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InetAddress" -- throws : False -- Skip return : False foreign import ccall "g_inet_socket_address_get_address" g_inet_socket_address_get_address :: Ptr InetSocketAddress -> -- _obj : TInterface "Gio" "InetSocketAddress" IO (Ptr InetAddress) inetSocketAddressGetAddress :: (MonadIO m, InetSocketAddressK a) => a -> -- _obj m InetAddress inetSocketAddressGetAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_socket_address_get_address _obj' checkUnexpectedReturnNULL "g_inet_socket_address_get_address" result result' <- (newObject InetAddress) result touchManagedPtr _obj return result' -- method InetSocketAddress::get_flowinfo -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_inet_socket_address_get_flowinfo" g_inet_socket_address_get_flowinfo :: Ptr InetSocketAddress -> -- _obj : TInterface "Gio" "InetSocketAddress" IO Word32 inetSocketAddressGetFlowinfo :: (MonadIO m, InetSocketAddressK a) => a -> -- _obj m Word32 inetSocketAddressGetFlowinfo _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_socket_address_get_flowinfo _obj' touchManagedPtr _obj return result -- method InetSocketAddress::get_port -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "g_inet_socket_address_get_port" g_inet_socket_address_get_port :: Ptr InetSocketAddress -> -- _obj : TInterface "Gio" "InetSocketAddress" IO Word16 inetSocketAddressGetPort :: (MonadIO m, InetSocketAddressK a) => a -> -- _obj m Word16 inetSocketAddressGetPort _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_socket_address_get_port _obj' touchManagedPtr _obj return result -- method InetSocketAddress::get_scope_id -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InetSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InetSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_inet_socket_address_get_scope_id" g_inet_socket_address_get_scope_id :: Ptr InetSocketAddress -> -- _obj : TInterface "Gio" "InetSocketAddress" IO Word32 inetSocketAddressGetScopeId :: (MonadIO m, InetSocketAddressK a) => a -> -- _obj m Word32 inetSocketAddressGetScopeId _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_inet_socket_address_get_scope_id _obj' touchManagedPtr _obj return result -- interface Initable newtype Initable = Initable (ForeignPtr Initable) noInitable :: Maybe Initable noInitable = Nothing foreign import ccall "g_initable_get_type" c_g_initable_get_type :: IO GType type instance ParentTypes Initable = '[GObject.Object] instance GObject Initable where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_initable_get_type class GObject o => InitableK o instance (GObject o, IsDescendantOf Initable o) => InitableK o toInitable :: InitableK o => o -> IO Initable toInitable = unsafeCastTo Initable -- method Initable::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Initable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Initable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_initable_init" g_initable_init :: Ptr Initable -> -- _obj : TInterface "Gio" "Initable" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt initableInit :: (MonadIO m, InitableK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () initableInit _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_initable_init _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- object InputStream newtype InputStream = InputStream (ForeignPtr InputStream) noInputStream :: Maybe InputStream noInputStream = Nothing foreign import ccall "g_input_stream_get_type" c_g_input_stream_get_type :: IO GType type instance ParentTypes InputStream = '[GObject.Object] instance GObject InputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_input_stream_get_type class GObject o => InputStreamK o instance (GObject o, IsDescendantOf InputStream o) => InputStreamK o toInputStream :: InputStreamK o => o -> IO InputStream toInputStream = unsafeCastTo InputStream -- method InputStream::clear_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_input_stream_clear_pending" g_input_stream_clear_pending :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" IO () inputStreamClearPending :: (MonadIO m, InputStreamK a) => a -> -- _obj m () inputStreamClearPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_input_stream_clear_pending _obj' touchManagedPtr _obj return () -- method InputStream::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_input_stream_close" g_input_stream_close :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt inputStreamClose :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () inputStreamClose _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_input_stream_close _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method InputStream::close_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_input_stream_close_async" g_input_stream_close_async :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () inputStreamCloseAsync :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () inputStreamCloseAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_input_stream_close_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method InputStream::close_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_input_stream_close_finish" g_input_stream_close_finish :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt inputStreamCloseFinish :: (MonadIO m, InputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m () inputStreamCloseFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_input_stream_close_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method InputStream::has_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_input_stream_has_pending" g_input_stream_has_pending :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" IO CInt inputStreamHasPending :: (MonadIO m, InputStreamK a) => a -> -- _obj m Bool inputStreamHasPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_input_stream_has_pending _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InputStream::is_closed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_input_stream_is_closed" g_input_stream_is_closed :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" IO CInt inputStreamIsClosed :: (MonadIO m, InputStreamK a) => a -> -- _obj m Bool inputStreamIsClosed _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_input_stream_is_closed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method InputStream::read -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_input_stream_read" g_input_stream_read :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 inputStreamRead :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m Int64 inputStreamRead _obj buffer cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_input_stream_read _obj' buffer' count maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- method InputStream::read_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_input_stream_read_all" g_input_stream_read_all :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Ptr Word64 -> -- bytes_read : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt inputStreamReadAll :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m (Word64) inputStreamReadAll _obj buffer cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer bytes_read <- allocMem :: IO (Ptr Word64) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_input_stream_read_all _obj' buffer' count bytes_read maybeCancellable bytes_read' <- peek bytes_read touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' freeMem bytes_read return bytes_read' ) (do freeMem buffer' freeMem bytes_read ) -- method InputStream::read_all_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_input_stream_read_all_async" g_input_stream_read_all_async :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () inputStreamReadAllAsync :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () inputStreamReadAllAsync _obj buffer io_priority cancellable callback = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_input_stream_read_all_async _obj' buffer' count io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return () -- method InputStream::read_all_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_input_stream_read_all_finish" g_input_stream_read_all_finish :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr Word64 -> -- bytes_read : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CInt inputStreamReadAllFinish :: (MonadIO m, InputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m (Word64) inputStreamReadAllFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ bytes_read <- allocMem :: IO (Ptr Word64) onException (do _ <- propagateGError $ g_input_stream_read_all_finish _obj' result_' bytes_read bytes_read' <- peek bytes_read touchManagedPtr _obj touchManagedPtr result_ freeMem bytes_read return bytes_read' ) (do freeMem bytes_read ) -- method InputStream::read_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_input_stream_read_async" g_input_stream_read_async :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () inputStreamReadAsync :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () inputStreamReadAsync _obj buffer io_priority cancellable callback = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_input_stream_read_async _obj' buffer' count io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return () -- method InputStream::read_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : True -- Skip return : False foreign import ccall "g_input_stream_read_bytes" g_input_stream_read_bytes :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Word64 -> -- count : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr GLib.Bytes) inputStreamReadBytes :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj Word64 -> -- count Maybe (b) -> -- cancellable m GLib.Bytes inputStreamReadBytes _obj count cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_input_stream_read_bytes _obj' count maybeCancellable checkUnexpectedReturnNULL "g_input_stream_read_bytes" result result' <- (wrapBoxed GLib.Bytes) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method InputStream::read_bytes_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_input_stream_read_bytes_async" g_input_stream_read_bytes_async :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Word64 -> -- count : TBasicType TUInt64 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () inputStreamReadBytesAsync :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj Word64 -> -- count Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () inputStreamReadBytesAsync _obj count io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_input_stream_read_bytes_async _obj' count io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method InputStream::read_bytes_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : True -- Skip return : False foreign import ccall "g_input_stream_read_bytes_finish" g_input_stream_read_bytes_finish :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr GLib.Bytes) inputStreamReadBytesFinish :: (MonadIO m, InputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m GLib.Bytes inputStreamReadBytesFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_input_stream_read_bytes_finish _obj' result_' checkUnexpectedReturnNULL "g_input_stream_read_bytes_finish" result result' <- (wrapBoxed GLib.Bytes) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method InputStream::read_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_input_stream_read_finish" g_input_stream_read_finish :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO Int64 inputStreamReadFinish :: (MonadIO m, InputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m Int64 inputStreamReadFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_input_stream_read_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return result ) (do return () ) -- method InputStream::set_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_input_stream_set_pending" g_input_stream_set_pending :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr (Ptr GError) -> -- error IO CInt inputStreamSetPending :: (MonadIO m, InputStreamK a) => a -> -- _obj m () inputStreamSetPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_input_stream_set_pending _obj' touchManagedPtr _obj return () ) (do return () ) -- method InputStream::skip -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_input_stream_skip" g_input_stream_skip :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Word64 -> -- count : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 inputStreamSkip :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj Word64 -> -- count Maybe (b) -> -- cancellable m Int64 inputStreamSkip _obj count cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_input_stream_skip _obj' count maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method InputStream::skip_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_input_stream_skip_async" g_input_stream_skip_async :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Word64 -> -- count : TBasicType TUInt64 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () inputStreamSkipAsync :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- _obj Word64 -> -- count Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () inputStreamSkipAsync _obj count io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_input_stream_skip_async _obj' count io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method InputStream::skip_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_input_stream_skip_finish" g_input_stream_skip_finish :: Ptr InputStream -> -- _obj : TInterface "Gio" "InputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO Int64 inputStreamSkipFinish :: (MonadIO m, InputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m Int64 inputStreamSkipFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_input_stream_skip_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return result ) (do return () ) -- struct InputVector newtype InputVector = InputVector (ForeignPtr InputVector) noInputVector :: Maybe InputVector noInputVector = Nothing inputVectorReadBuffer :: InputVector -> IO (Ptr ()) inputVectorReadBuffer s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val inputVectorReadSize :: InputVector -> IO Word64 inputVectorReadSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word64 return val -- interface ListModel newtype ListModel = ListModel (ForeignPtr ListModel) noListModel :: Maybe ListModel noListModel = Nothing foreign import ccall "g_list_model_get_type" c_g_list_model_get_type :: IO GType type instance ParentTypes ListModel = '[GObject.Object] instance GObject ListModel where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_list_model_get_type class GObject o => ListModelK o instance (GObject o, IsDescendantOf ListModel o) => ListModelK o toListModel :: ListModelK o => o -> IO ListModel toListModel = unsafeCastTo ListModel -- method ListModel::get_item_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_list_model_get_item_type" g_list_model_get_item_type :: Ptr ListModel -> -- _obj : TInterface "Gio" "ListModel" IO CGType listModelGetItemType :: (MonadIO m, ListModelK a) => a -> -- _obj m GType listModelGetItemType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_list_model_get_item_type _obj' let result' = GType result touchManagedPtr _obj return result' -- method ListModel::get_n_items -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_list_model_get_n_items" g_list_model_get_n_items :: Ptr ListModel -> -- _obj : TInterface "Gio" "ListModel" IO Word32 listModelGetNItems :: (MonadIO m, ListModelK a) => a -> -- _obj m Word32 listModelGetNItems _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_list_model_get_n_items _obj' touchManagedPtr _obj return result -- method ListModel::get_item -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_list_model_get_object" g_list_model_get_object :: Ptr ListModel -> -- _obj : TInterface "Gio" "ListModel" Word32 -> -- position : TBasicType TUInt32 IO (Ptr GObject.Object) listModelGetItem :: (MonadIO m, ListModelK a) => a -> -- _obj Word32 -> -- position m GObject.Object listModelGetItem _obj position = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_list_model_get_object _obj' position checkUnexpectedReturnNULL "g_list_model_get_object" result result' <- (wrapObject GObject.Object) result touchManagedPtr _obj return result' -- method ListModel::items_changed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "removed", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "added", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "removed", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "added", 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_list_model_items_changed" g_list_model_items_changed :: Ptr ListModel -> -- _obj : TInterface "Gio" "ListModel" Word32 -> -- position : TBasicType TUInt32 Word32 -> -- removed : TBasicType TUInt32 Word32 -> -- added : TBasicType TUInt32 IO () listModelItemsChanged :: (MonadIO m, ListModelK a) => a -> -- _obj Word32 -> -- position Word32 -> -- removed Word32 -> -- added m () listModelItemsChanged _obj position removed added = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_list_model_items_changed _obj' position removed added touchManagedPtr _obj return () -- signal ListModel::items-changed type ListModelItemsChangedCallback = Word32 -> Word32 -> Word32 -> IO () noListModelItemsChangedCallback :: Maybe ListModelItemsChangedCallback noListModelItemsChangedCallback = Nothing type ListModelItemsChangedCallbackC = Ptr () -> -- object Word32 -> Word32 -> Word32 -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkListModelItemsChangedCallback :: ListModelItemsChangedCallbackC -> IO (FunPtr ListModelItemsChangedCallbackC) listModelItemsChangedClosure :: ListModelItemsChangedCallback -> IO Closure listModelItemsChangedClosure cb = newCClosure =<< mkListModelItemsChangedCallback wrapped where wrapped = listModelItemsChangedCallbackWrapper cb listModelItemsChangedCallbackWrapper :: ListModelItemsChangedCallback -> Ptr () -> Word32 -> Word32 -> Word32 -> Ptr () -> IO () listModelItemsChangedCallbackWrapper _cb _ position removed added _ = do _cb position removed added onListModelItemsChanged :: (GObject a, MonadIO m) => a -> ListModelItemsChangedCallback -> m SignalHandlerId onListModelItemsChanged obj cb = liftIO $ connectListModelItemsChanged obj cb SignalConnectBefore afterListModelItemsChanged :: (GObject a, MonadIO m) => a -> ListModelItemsChangedCallback -> m SignalHandlerId afterListModelItemsChanged obj cb = connectListModelItemsChanged obj cb SignalConnectAfter connectListModelItemsChanged :: (GObject a, MonadIO m) => a -> ListModelItemsChangedCallback -> SignalConnectMode -> m SignalHandlerId connectListModelItemsChanged obj cb after = liftIO $ do cb' <- mkListModelItemsChangedCallback (listModelItemsChangedCallbackWrapper cb) connectSignalFunPtr obj "items-changed" cb' after -- object ListStore newtype ListStore = ListStore (ForeignPtr ListStore) noListStore :: Maybe ListStore noListStore = Nothing foreign import ccall "g_list_store_get_type" c_g_list_store_get_type :: IO GType type instance ParentTypes ListStore = '[GObject.Object, ListModel] instance GObject ListStore where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_list_store_get_type class GObject o => ListStoreK o instance (GObject o, IsDescendantOf ListStore o) => ListStoreK o toListStore :: ListStoreK o => o -> IO ListStore toListStore = unsafeCastTo ListStore -- method ListStore::new -- method type : Constructor -- Args : [Arg {argName = "item_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "item_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ListStore" -- throws : False -- Skip return : False foreign import ccall "g_list_store_new" g_list_store_new :: CGType -> -- item_type : TBasicType TGType IO (Ptr ListStore) listStoreNew :: (MonadIO m) => GType -> -- item_type m ListStore listStoreNew item_type = liftIO $ do let item_type' = gtypeToCGType item_type result <- g_list_store_new item_type' checkUnexpectedReturnNULL "g_list_store_new" result result' <- (wrapObject ListStore) result return result' -- method ListStore::append -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ListStore", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ListStore", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", 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_list_store_append" g_list_store_append :: Ptr ListStore -> -- _obj : TInterface "Gio" "ListStore" Ptr () -> -- item : TBasicType TVoid IO () listStoreAppend :: (MonadIO m, ListStoreK a) => a -> -- _obj Ptr () -> -- item m () listStoreAppend _obj item = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_list_store_append _obj' item touchManagedPtr _obj return () -- method ListStore::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ListStore", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ListStore", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", 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_list_store_insert" g_list_store_insert :: Ptr ListStore -> -- _obj : TInterface "Gio" "ListStore" Word32 -> -- position : TBasicType TUInt32 Ptr () -> -- item : TBasicType TVoid IO () listStoreInsert :: (MonadIO m, ListStoreK a) => a -> -- _obj Word32 -> -- position Ptr () -> -- item m () listStoreInsert _obj position item = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_list_store_insert _obj' position item touchManagedPtr _obj return () -- method ListStore::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ListStore", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ListStore", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", 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_list_store_remove" g_list_store_remove :: Ptr ListStore -> -- _obj : TInterface "Gio" "ListStore" Word32 -> -- position : TBasicType TUInt32 IO () listStoreRemove :: (MonadIO m, ListStoreK a) => a -> -- _obj Word32 -> -- position m () listStoreRemove _obj position = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_list_store_remove _obj' position touchManagedPtr _obj return () -- method ListStore::remove_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ListStore", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ListStore", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_list_store_remove_all" g_list_store_remove_all :: Ptr ListStore -> -- _obj : TInterface "Gio" "ListStore" IO () listStoreRemoveAll :: (MonadIO m, ListStoreK a) => a -> -- _obj m () listStoreRemoveAll _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_list_store_remove_all _obj' touchManagedPtr _obj return () -- interface LoadableIcon newtype LoadableIcon = LoadableIcon (ForeignPtr LoadableIcon) noLoadableIcon :: Maybe LoadableIcon noLoadableIcon = Nothing foreign import ccall "g_loadable_icon_get_type" c_g_loadable_icon_get_type :: IO GType type instance ParentTypes LoadableIcon = '[Icon, GObject.Object] instance GObject LoadableIcon where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_loadable_icon_get_type class GObject o => LoadableIconK o instance (GObject o, IsDescendantOf LoadableIcon o) => LoadableIconK o toLoadableIcon :: LoadableIconK o => o -> IO LoadableIcon toLoadableIcon = unsafeCastTo LoadableIcon -- method LoadableIcon::load -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "LoadableIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "LoadableIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : True -- Skip return : False foreign import ccall "g_loadable_icon_load" g_loadable_icon_load :: Ptr LoadableIcon -> -- _obj : TInterface "Gio" "LoadableIcon" Int32 -> -- size : TBasicType TInt32 Ptr CString -> -- type : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr InputStream) loadableIconLoad :: (MonadIO m, LoadableIconK a, CancellableK b) => a -> -- _obj Int32 -> -- size Maybe (b) -> -- cancellable m (InputStream,T.Text) loadableIconLoad _obj size cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj type_ <- allocMem :: IO (Ptr CString) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_loadable_icon_load _obj' size type_ maybeCancellable checkUnexpectedReturnNULL "g_loadable_icon_load" result result' <- (wrapObject InputStream) result type_' <- peek type_ type_'' <- cstringToText type_' freeMem type_' touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem type_ return (result', type_'') ) (do freeMem type_ ) -- method LoadableIcon::load_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "LoadableIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "LoadableIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_loadable_icon_load_async" g_loadable_icon_load_async :: Ptr LoadableIcon -> -- _obj : TInterface "Gio" "LoadableIcon" Int32 -> -- size : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () loadableIconLoadAsync :: (MonadIO m, LoadableIconK a, CancellableK b) => a -> -- _obj Int32 -> -- size Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () loadableIconLoadAsync _obj size cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_loadable_icon_load_async _obj' size maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method LoadableIcon::load_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "LoadableIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "LoadableIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : True -- Skip return : False foreign import ccall "g_loadable_icon_load_finish" g_loadable_icon_load_finish :: Ptr LoadableIcon -> -- _obj : TInterface "Gio" "LoadableIcon" Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr CString -> -- type : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr InputStream) loadableIconLoadFinish :: (MonadIO m, LoadableIconK a, AsyncResultK b) => a -> -- _obj b -> -- res m (InputStream,T.Text) loadableIconLoadFinish _obj res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let res' = unsafeManagedPtrCastPtr res type_ <- allocMem :: IO (Ptr CString) onException (do result <- propagateGError $ g_loadable_icon_load_finish _obj' res' type_ checkUnexpectedReturnNULL "g_loadable_icon_load_finish" result result' <- (wrapObject InputStream) result type_' <- peek type_ type_'' <- cstringToText type_' freeMem type_' touchManagedPtr _obj touchManagedPtr res freeMem type_ return (result', type_'') ) (do freeMem type_ ) -- object MemoryInputStream newtype MemoryInputStream = MemoryInputStream (ForeignPtr MemoryInputStream) noMemoryInputStream :: Maybe MemoryInputStream noMemoryInputStream = Nothing foreign import ccall "g_memory_input_stream_get_type" c_g_memory_input_stream_get_type :: IO GType type instance ParentTypes MemoryInputStream = '[InputStream, GObject.Object, PollableInputStream, Seekable] instance GObject MemoryInputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_memory_input_stream_get_type class GObject o => MemoryInputStreamK o instance (GObject o, IsDescendantOf MemoryInputStream o) => MemoryInputStreamK o toMemoryInputStream :: MemoryInputStreamK o => o -> IO MemoryInputStream toMemoryInputStream = unsafeCastTo MemoryInputStream -- method MemoryInputStream::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "MemoryInputStream" -- throws : False -- Skip return : False foreign import ccall "g_memory_input_stream_new" g_memory_input_stream_new :: IO (Ptr MemoryInputStream) memoryInputStreamNew :: (MonadIO m) => m MemoryInputStream memoryInputStreamNew = liftIO $ do result <- g_memory_input_stream_new checkUnexpectedReturnNULL "g_memory_input_stream_new" result result' <- (wrapObject MemoryInputStream) result return result' -- method MemoryInputStream::new_from_bytes -- method type : Constructor -- Args : [Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MemoryInputStream" -- throws : False -- Skip return : False foreign import ccall "g_memory_input_stream_new_from_bytes" g_memory_input_stream_new_from_bytes :: Ptr GLib.Bytes -> -- bytes : TInterface "GLib" "Bytes" IO (Ptr MemoryInputStream) memoryInputStreamNewFromBytes :: (MonadIO m) => GLib.Bytes -> -- bytes m MemoryInputStream memoryInputStreamNewFromBytes bytes = liftIO $ do let bytes' = unsafeManagedPtrGetPtr bytes result <- g_memory_input_stream_new_from_bytes bytes' checkUnexpectedReturnNULL "g_memory_input_stream_new_from_bytes" result result' <- (wrapObject MemoryInputStream) result touchManagedPtr bytes return result' -- method MemoryInputStream::new_from_data -- method type : Constructor -- 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 TInt64, direction = DirectionIn, mayBeNull = False, 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 : [Arg {argName = "len", argType = TBasicType TInt64, 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},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MemoryInputStream" -- throws : False -- Skip return : False foreign import ccall "g_memory_input_stream_new_from_data" g_memory_input_stream_new_from_data :: Ptr Word8 -> -- data : TCArray False (-1) 1 (TBasicType TUInt8) Int64 -> -- len : TBasicType TInt64 FunPtr GLib.DestroyNotifyC -> -- destroy : TInterface "GLib" "DestroyNotify" IO (Ptr MemoryInputStream) memoryInputStreamNewFromData :: (MonadIO m) => ByteString -> -- data Maybe (GLib.DestroyNotify) -> -- destroy m MemoryInputStream memoryInputStreamNewFromData data_ destroy = liftIO $ do let len = fromIntegral $ B.length data_ data_' <- packByteString data_ ptrdestroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeDestroy <- case destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jDestroy -> do jDestroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrdestroy) jDestroy) poke ptrdestroy jDestroy' return jDestroy' result <- g_memory_input_stream_new_from_data data_' len maybeDestroy checkUnexpectedReturnNULL "g_memory_input_stream_new_from_data" result result' <- (wrapObject MemoryInputStream) result return result' -- method MemoryInputStream::add_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", 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_memory_input_stream_add_bytes" g_memory_input_stream_add_bytes :: Ptr MemoryInputStream -> -- _obj : TInterface "Gio" "MemoryInputStream" Ptr GLib.Bytes -> -- bytes : TInterface "GLib" "Bytes" IO () memoryInputStreamAddBytes :: (MonadIO m, MemoryInputStreamK a) => a -> -- _obj GLib.Bytes -> -- bytes m () memoryInputStreamAddBytes _obj bytes = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let bytes' = unsafeManagedPtrGetPtr bytes g_memory_input_stream_add_bytes _obj' bytes' touchManagedPtr _obj touchManagedPtr bytes return () -- method MemoryInputStream::add_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryInputStream", 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 = TransferEverything},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, 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 : [Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryInputStream", 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 = TransferEverything},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_memory_input_stream_add_data" g_memory_input_stream_add_data :: Ptr MemoryInputStream -> -- _obj : TInterface "Gio" "MemoryInputStream" Ptr Word8 -> -- data : TCArray False (-1) 2 (TBasicType TUInt8) Int64 -> -- len : TBasicType TInt64 FunPtr GLib.DestroyNotifyC -> -- destroy : TInterface "GLib" "DestroyNotify" IO () memoryInputStreamAddData :: (MonadIO m, MemoryInputStreamK a) => a -> -- _obj ByteString -> -- data Maybe (GLib.DestroyNotify) -> -- destroy m () memoryInputStreamAddData _obj data_ destroy = liftIO $ do let len = fromIntegral $ B.length data_ let _obj' = unsafeManagedPtrCastPtr _obj data_' <- packByteString data_ ptrdestroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeDestroy <- case destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jDestroy -> do jDestroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrdestroy) jDestroy) poke ptrdestroy jDestroy' return jDestroy' g_memory_input_stream_add_data _obj' data_' len maybeDestroy touchManagedPtr _obj return () -- object MemoryOutputStream newtype MemoryOutputStream = MemoryOutputStream (ForeignPtr MemoryOutputStream) noMemoryOutputStream :: Maybe MemoryOutputStream noMemoryOutputStream = Nothing foreign import ccall "g_memory_output_stream_get_type" c_g_memory_output_stream_get_type :: IO GType type instance ParentTypes MemoryOutputStream = '[OutputStream, GObject.Object, PollableOutputStream, Seekable] instance GObject MemoryOutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_memory_output_stream_get_type class GObject o => MemoryOutputStreamK o instance (GObject o, IsDescendantOf MemoryOutputStream o) => MemoryOutputStreamK o toMemoryOutputStream :: MemoryOutputStreamK o => o -> IO MemoryOutputStream toMemoryOutputStream = unsafeCastTo MemoryOutputStream -- method MemoryOutputStream::new_resizable -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "MemoryOutputStream" -- throws : False -- Skip return : False foreign import ccall "g_memory_output_stream_new_resizable" g_memory_output_stream_new_resizable :: IO (Ptr MemoryOutputStream) memoryOutputStreamNewResizable :: (MonadIO m) => m MemoryOutputStream memoryOutputStreamNewResizable = liftIO $ do result <- g_memory_output_stream_new_resizable checkUnexpectedReturnNULL "g_memory_output_stream_new_resizable" result result' <- (wrapObject MemoryOutputStream) result return result' -- method MemoryOutputStream::get_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_memory_output_stream_get_data" g_memory_output_stream_get_data :: Ptr MemoryOutputStream -> -- _obj : TInterface "Gio" "MemoryOutputStream" IO () memoryOutputStreamGetData :: (MonadIO m, MemoryOutputStreamK a) => a -> -- _obj m () memoryOutputStreamGetData _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_memory_output_stream_get_data _obj' touchManagedPtr _obj return () -- method MemoryOutputStream::get_data_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_memory_output_stream_get_data_size" g_memory_output_stream_get_data_size :: Ptr MemoryOutputStream -> -- _obj : TInterface "Gio" "MemoryOutputStream" IO Word64 memoryOutputStreamGetDataSize :: (MonadIO m, MemoryOutputStreamK a) => a -> -- _obj m Word64 memoryOutputStreamGetDataSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_memory_output_stream_get_data_size _obj' touchManagedPtr _obj return result -- method MemoryOutputStream::get_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_memory_output_stream_get_size" g_memory_output_stream_get_size :: Ptr MemoryOutputStream -> -- _obj : TInterface "Gio" "MemoryOutputStream" IO Word64 memoryOutputStreamGetSize :: (MonadIO m, MemoryOutputStreamK a) => a -> -- _obj m Word64 memoryOutputStreamGetSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_memory_output_stream_get_size _obj' touchManagedPtr _obj return result -- method MemoryOutputStream::steal_as_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", 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_memory_output_stream_steal_as_bytes" g_memory_output_stream_steal_as_bytes :: Ptr MemoryOutputStream -> -- _obj : TInterface "Gio" "MemoryOutputStream" IO (Ptr GLib.Bytes) memoryOutputStreamStealAsBytes :: (MonadIO m, MemoryOutputStreamK a) => a -> -- _obj m GLib.Bytes memoryOutputStreamStealAsBytes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_memory_output_stream_steal_as_bytes _obj' checkUnexpectedReturnNULL "g_memory_output_stream_steal_as_bytes" result result' <- (wrapBoxed GLib.Bytes) result touchManagedPtr _obj return result' -- method MemoryOutputStream::steal_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MemoryOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_memory_output_stream_steal_data" g_memory_output_stream_steal_data :: Ptr MemoryOutputStream -> -- _obj : TInterface "Gio" "MemoryOutputStream" IO () memoryOutputStreamStealData :: (MonadIO m, MemoryOutputStreamK a) => a -> -- _obj m () memoryOutputStreamStealData _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_memory_output_stream_steal_data _obj' touchManagedPtr _obj return () -- object Menu newtype Menu = Menu (ForeignPtr Menu) noMenu :: Maybe Menu noMenu = Nothing foreign import ccall "g_menu_get_type" c_g_menu_get_type :: IO GType type instance ParentTypes Menu = '[MenuModel, GObject.Object] instance GObject Menu where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_menu_get_type class GObject o => MenuK o instance (GObject o, IsDescendantOf Menu o) => MenuK o toMenu :: MenuK o => o -> IO Menu toMenu = unsafeCastTo Menu -- method Menu::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "Menu" -- throws : False -- Skip return : False foreign import ccall "g_menu_new" g_menu_new :: IO (Ptr Menu) menuNew :: (MonadIO m) => m Menu menuNew = liftIO $ do result <- g_menu_new checkUnexpectedReturnNULL "g_menu_new" result result' <- (wrapObject Menu) result return result' -- method Menu::append -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", 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_menu_append" g_menu_append :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" CString -> -- label : TBasicType TUTF8 CString -> -- detailed_action : TBasicType TUTF8 IO () menuAppend :: (MonadIO m, MenuK a) => a -> -- _obj Maybe (T.Text) -> -- label Maybe (T.Text) -> -- detailed_action m () menuAppend _obj label detailed_action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' maybeDetailed_action <- case detailed_action of Nothing -> return nullPtr Just jDetailed_action -> do jDetailed_action' <- textToCString jDetailed_action return jDetailed_action' g_menu_append _obj' maybeLabel maybeDetailed_action touchManagedPtr _obj freeMem maybeLabel freeMem maybeDetailed_action return () -- method Menu::append_item -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_append_item" g_menu_append_item :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" Ptr MenuItem -> -- item : TInterface "Gio" "MenuItem" IO () menuAppendItem :: (MonadIO m, MenuK a, MenuItemK b) => a -> -- _obj b -> -- item m () menuAppendItem _obj item = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let item' = unsafeManagedPtrCastPtr item g_menu_append_item _obj' item' touchManagedPtr _obj touchManagedPtr item return () -- method Menu::append_section -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_append_section" g_menu_append_section :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" CString -> -- label : TBasicType TUTF8 Ptr MenuModel -> -- section : TInterface "Gio" "MenuModel" IO () menuAppendSection :: (MonadIO m, MenuK a, MenuModelK b) => a -> -- _obj Maybe (T.Text) -> -- label b -> -- section m () menuAppendSection _obj label section = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' let section' = unsafeManagedPtrCastPtr section g_menu_append_section _obj' maybeLabel section' touchManagedPtr _obj touchManagedPtr section freeMem maybeLabel return () -- method Menu::append_submenu -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_append_submenu" g_menu_append_submenu :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" CString -> -- label : TBasicType TUTF8 Ptr MenuModel -> -- submenu : TInterface "Gio" "MenuModel" IO () menuAppendSubmenu :: (MonadIO m, MenuK a, MenuModelK b) => a -> -- _obj Maybe (T.Text) -> -- label b -> -- submenu m () menuAppendSubmenu _obj label submenu = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' let submenu' = unsafeManagedPtrCastPtr submenu g_menu_append_submenu _obj' maybeLabel submenu' touchManagedPtr _obj touchManagedPtr submenu freeMem maybeLabel return () -- method Menu::freeze -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_freeze" g_menu_freeze :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" IO () menuFreeze :: (MonadIO m, MenuK a) => a -> -- _obj m () menuFreeze _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_menu_freeze _obj' touchManagedPtr _obj return () -- method Menu::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", 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_menu_insert" g_menu_insert :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" Int32 -> -- position : TBasicType TInt32 CString -> -- label : TBasicType TUTF8 CString -> -- detailed_action : TBasicType TUTF8 IO () menuInsert :: (MonadIO m, MenuK a) => a -> -- _obj Int32 -> -- position Maybe (T.Text) -> -- label Maybe (T.Text) -> -- detailed_action m () menuInsert _obj position label detailed_action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' maybeDetailed_action <- case detailed_action of Nothing -> return nullPtr Just jDetailed_action -> do jDetailed_action' <- textToCString jDetailed_action return jDetailed_action' g_menu_insert _obj' position maybeLabel maybeDetailed_action touchManagedPtr _obj freeMem maybeLabel freeMem maybeDetailed_action return () -- method Menu::insert_item -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_insert_item" g_menu_insert_item :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" Int32 -> -- position : TBasicType TInt32 Ptr MenuItem -> -- item : TInterface "Gio" "MenuItem" IO () menuInsertItem :: (MonadIO m, MenuK a, MenuItemK b) => a -> -- _obj Int32 -> -- position b -> -- item m () menuInsertItem _obj position item = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let item' = unsafeManagedPtrCastPtr item g_menu_insert_item _obj' position item' touchManagedPtr _obj touchManagedPtr item return () -- method Menu::insert_section -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_insert_section" g_menu_insert_section :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" Int32 -> -- position : TBasicType TInt32 CString -> -- label : TBasicType TUTF8 Ptr MenuModel -> -- section : TInterface "Gio" "MenuModel" IO () menuInsertSection :: (MonadIO m, MenuK a, MenuModelK b) => a -> -- _obj Int32 -> -- position Maybe (T.Text) -> -- label b -> -- section m () menuInsertSection _obj position label section = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' let section' = unsafeManagedPtrCastPtr section g_menu_insert_section _obj' position maybeLabel section' touchManagedPtr _obj touchManagedPtr section freeMem maybeLabel return () -- method Menu::insert_submenu -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_insert_submenu" g_menu_insert_submenu :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" Int32 -> -- position : TBasicType TInt32 CString -> -- label : TBasicType TUTF8 Ptr MenuModel -> -- submenu : TInterface "Gio" "MenuModel" IO () menuInsertSubmenu :: (MonadIO m, MenuK a, MenuModelK b) => a -> -- _obj Int32 -> -- position Maybe (T.Text) -> -- label b -> -- submenu m () menuInsertSubmenu _obj position label submenu = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' let submenu' = unsafeManagedPtrCastPtr submenu g_menu_insert_submenu _obj' position maybeLabel submenu' touchManagedPtr _obj touchManagedPtr submenu freeMem maybeLabel return () -- method Menu::prepend -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", 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_menu_prepend" g_menu_prepend :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" CString -> -- label : TBasicType TUTF8 CString -> -- detailed_action : TBasicType TUTF8 IO () menuPrepend :: (MonadIO m, MenuK a) => a -> -- _obj Maybe (T.Text) -> -- label Maybe (T.Text) -> -- detailed_action m () menuPrepend _obj label detailed_action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' maybeDetailed_action <- case detailed_action of Nothing -> return nullPtr Just jDetailed_action -> do jDetailed_action' <- textToCString jDetailed_action return jDetailed_action' g_menu_prepend _obj' maybeLabel maybeDetailed_action touchManagedPtr _obj freeMem maybeLabel freeMem maybeDetailed_action return () -- method Menu::prepend_item -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_prepend_item" g_menu_prepend_item :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" Ptr MenuItem -> -- item : TInterface "Gio" "MenuItem" IO () menuPrependItem :: (MonadIO m, MenuK a, MenuItemK b) => a -> -- _obj b -> -- item m () menuPrependItem _obj item = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let item' = unsafeManagedPtrCastPtr item g_menu_prepend_item _obj' item' touchManagedPtr _obj touchManagedPtr item return () -- method Menu::prepend_section -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_prepend_section" g_menu_prepend_section :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" CString -> -- label : TBasicType TUTF8 Ptr MenuModel -> -- section : TInterface "Gio" "MenuModel" IO () menuPrependSection :: (MonadIO m, MenuK a, MenuModelK b) => a -> -- _obj Maybe (T.Text) -> -- label b -> -- section m () menuPrependSection _obj label section = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' let section' = unsafeManagedPtrCastPtr section g_menu_prepend_section _obj' maybeLabel section' touchManagedPtr _obj touchManagedPtr section freeMem maybeLabel return () -- method Menu::prepend_submenu -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_prepend_submenu" g_menu_prepend_submenu :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" CString -> -- label : TBasicType TUTF8 Ptr MenuModel -> -- submenu : TInterface "Gio" "MenuModel" IO () menuPrependSubmenu :: (MonadIO m, MenuK a, MenuModelK b) => a -> -- _obj Maybe (T.Text) -> -- label b -> -- submenu m () menuPrependSubmenu _obj label submenu = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' let submenu' = unsafeManagedPtrCastPtr submenu g_menu_prepend_submenu _obj' maybeLabel submenu' touchManagedPtr _obj touchManagedPtr submenu freeMem maybeLabel return () -- method Menu::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", 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_menu_remove" g_menu_remove :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" Int32 -> -- position : TBasicType TInt32 IO () menuRemove :: (MonadIO m, MenuK a) => a -> -- _obj Int32 -> -- position m () menuRemove _obj position = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_menu_remove _obj' position touchManagedPtr _obj return () -- method Menu::remove_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Menu", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_remove_all" g_menu_remove_all :: Ptr Menu -> -- _obj : TInterface "Gio" "Menu" IO () menuRemoveAll :: (MonadIO m, MenuK a) => a -> -- _obj m () menuRemoveAll _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_menu_remove_all _obj' touchManagedPtr _obj return () -- object MenuAttributeIter newtype MenuAttributeIter = MenuAttributeIter (ForeignPtr MenuAttributeIter) noMenuAttributeIter :: Maybe MenuAttributeIter noMenuAttributeIter = Nothing foreign import ccall "g_menu_attribute_iter_get_type" c_g_menu_attribute_iter_get_type :: IO GType type instance ParentTypes MenuAttributeIter = '[GObject.Object] instance GObject MenuAttributeIter where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_menu_attribute_iter_get_type class GObject o => MenuAttributeIterK o instance (GObject o, IsDescendantOf MenuAttributeIter o) => MenuAttributeIterK o toMenuAttributeIter :: MenuAttributeIterK o => o -> IO MenuAttributeIter toMenuAttributeIter = unsafeCastTo MenuAttributeIter -- method MenuAttributeIter::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuAttributeIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuAttributeIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_menu_attribute_iter_get_name" g_menu_attribute_iter_get_name :: Ptr MenuAttributeIter -> -- _obj : TInterface "Gio" "MenuAttributeIter" IO CString menuAttributeIterGetName :: (MonadIO m, MenuAttributeIterK a) => a -> -- _obj m T.Text menuAttributeIterGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_attribute_iter_get_name _obj' checkUnexpectedReturnNULL "g_menu_attribute_iter_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method MenuAttributeIter::get_next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuAttributeIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_name", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuAttributeIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_menu_attribute_iter_get_next" g_menu_attribute_iter_get_next :: Ptr MenuAttributeIter -> -- _obj : TInterface "Gio" "MenuAttributeIter" Ptr CString -> -- out_name : TBasicType TUTF8 Ptr (Ptr GVariant) -> -- value : TVariant IO CInt menuAttributeIterGetNext :: (MonadIO m, MenuAttributeIterK a) => a -> -- _obj m (Bool,T.Text,GVariant) menuAttributeIterGetNext _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj out_name <- allocMem :: IO (Ptr CString) value <- allocMem :: IO (Ptr (Ptr GVariant)) result <- g_menu_attribute_iter_get_next _obj' out_name value let result' = (/= 0) result out_name' <- peek out_name out_name'' <- cstringToText out_name' value' <- peek value value'' <- wrapGVariantPtr value' touchManagedPtr _obj freeMem out_name freeMem value return (result', out_name'', value'') -- method MenuAttributeIter::get_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuAttributeIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuAttributeIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_menu_attribute_iter_get_value" g_menu_attribute_iter_get_value :: Ptr MenuAttributeIter -> -- _obj : TInterface "Gio" "MenuAttributeIter" IO (Ptr GVariant) menuAttributeIterGetValue :: (MonadIO m, MenuAttributeIterK a) => a -> -- _obj m GVariant menuAttributeIterGetValue _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_attribute_iter_get_value _obj' checkUnexpectedReturnNULL "g_menu_attribute_iter_get_value" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method MenuAttributeIter::next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuAttributeIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuAttributeIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_menu_attribute_iter_next" g_menu_attribute_iter_next :: Ptr MenuAttributeIter -> -- _obj : TInterface "Gio" "MenuAttributeIter" IO CInt menuAttributeIterNext :: (MonadIO m, MenuAttributeIterK a) => a -> -- _obj m Bool menuAttributeIterNext _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_attribute_iter_next _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- object MenuItem newtype MenuItem = MenuItem (ForeignPtr MenuItem) noMenuItem :: Maybe MenuItem noMenuItem = Nothing foreign import ccall "g_menu_item_get_type" c_g_menu_item_get_type :: IO GType type instance ParentTypes MenuItem = '[GObject.Object] instance GObject MenuItem where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_menu_item_get_type class GObject o => MenuItemK o instance (GObject o, IsDescendantOf MenuItem o) => MenuItemK o toMenuItem :: MenuItemK o => o -> IO MenuItem toMenuItem = unsafeCastTo MenuItem -- method MenuItem::new -- method type : Constructor -- Args : [Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuItem" -- throws : False -- Skip return : False foreign import ccall "g_menu_item_new" g_menu_item_new :: CString -> -- label : TBasicType TUTF8 CString -> -- detailed_action : TBasicType TUTF8 IO (Ptr MenuItem) menuItemNew :: (MonadIO m) => Maybe (T.Text) -> -- label Maybe (T.Text) -> -- detailed_action m MenuItem menuItemNew label detailed_action = liftIO $ do maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' maybeDetailed_action <- case detailed_action of Nothing -> return nullPtr Just jDetailed_action -> do jDetailed_action' <- textToCString jDetailed_action return jDetailed_action' result <- g_menu_item_new maybeLabel maybeDetailed_action checkUnexpectedReturnNULL "g_menu_item_new" result result' <- (wrapObject MenuItem) result freeMem maybeLabel freeMem maybeDetailed_action return result' -- method MenuItem::new_from_model -- method type : Constructor -- Args : [Arg {argName = "model", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "model", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuItem" -- throws : False -- Skip return : False foreign import ccall "g_menu_item_new_from_model" g_menu_item_new_from_model :: Ptr MenuModel -> -- model : TInterface "Gio" "MenuModel" Int32 -> -- item_index : TBasicType TInt32 IO (Ptr MenuItem) menuItemNewFromModel :: (MonadIO m, MenuModelK a) => a -> -- model Int32 -> -- item_index m MenuItem menuItemNewFromModel model item_index = liftIO $ do let model' = unsafeManagedPtrCastPtr model result <- g_menu_item_new_from_model model' item_index checkUnexpectedReturnNULL "g_menu_item_new_from_model" result result' <- (wrapObject MenuItem) result touchManagedPtr model return result' -- method MenuItem::new_section -- method type : Constructor -- Args : [Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuItem" -- throws : False -- Skip return : False foreign import ccall "g_menu_item_new_section" g_menu_item_new_section :: CString -> -- label : TBasicType TUTF8 Ptr MenuModel -> -- section : TInterface "Gio" "MenuModel" IO (Ptr MenuItem) menuItemNewSection :: (MonadIO m, MenuModelK a) => Maybe (T.Text) -> -- label a -> -- section m MenuItem menuItemNewSection label section = liftIO $ do maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' let section' = unsafeManagedPtrCastPtr section result <- g_menu_item_new_section maybeLabel section' checkUnexpectedReturnNULL "g_menu_item_new_section" result result' <- (wrapObject MenuItem) result touchManagedPtr section freeMem maybeLabel return result' -- method MenuItem::new_submenu -- method type : Constructor -- Args : [Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuItem" -- throws : False -- Skip return : False foreign import ccall "g_menu_item_new_submenu" g_menu_item_new_submenu :: CString -> -- label : TBasicType TUTF8 Ptr MenuModel -> -- submenu : TInterface "Gio" "MenuModel" IO (Ptr MenuItem) menuItemNewSubmenu :: (MonadIO m, MenuModelK a) => Maybe (T.Text) -> -- label a -> -- submenu m MenuItem menuItemNewSubmenu label submenu = liftIO $ do maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' let submenu' = unsafeManagedPtrCastPtr submenu result <- g_menu_item_new_submenu maybeLabel submenu' checkUnexpectedReturnNULL "g_menu_item_new_submenu" result result' <- (wrapObject MenuItem) result touchManagedPtr submenu freeMem maybeLabel return result' -- method MenuItem::get_attribute_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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 "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_menu_item_get_attribute_value" g_menu_item_get_attribute_value :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" CString -> -- attribute : TBasicType TUTF8 Ptr GLib.VariantType -> -- expected_type : TInterface "GLib" "VariantType" IO (Ptr GVariant) menuItemGetAttributeValue :: (MonadIO m, MenuItemK a) => a -> -- _obj T.Text -> -- attribute Maybe (GLib.VariantType) -> -- expected_type m GVariant menuItemGetAttributeValue _obj attribute expected_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute maybeExpected_type <- case expected_type of Nothing -> return nullPtr Just jExpected_type -> do let jExpected_type' = unsafeManagedPtrGetPtr jExpected_type return jExpected_type' result <- g_menu_item_get_attribute_value _obj' attribute' maybeExpected_type checkUnexpectedReturnNULL "g_menu_item_get_attribute_value" result result' <- wrapGVariantPtr result touchManagedPtr _obj whenJust expected_type touchManagedPtr freeMem attribute' return result' -- method MenuItem::get_link -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "link", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "link", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuModel" -- throws : False -- Skip return : False foreign import ccall "g_menu_item_get_link" g_menu_item_get_link :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" CString -> -- link : TBasicType TUTF8 IO (Ptr MenuModel) menuItemGetLink :: (MonadIO m, MenuItemK a) => a -> -- _obj T.Text -> -- link m MenuModel menuItemGetLink _obj link = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj link' <- textToCString link result <- g_menu_item_get_link _obj' link' checkUnexpectedReturnNULL "g_menu_item_get_link" result result' <- (wrapObject MenuModel) result touchManagedPtr _obj freeMem link' return result' -- method MenuItem::set_action_and_target_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_item_set_action_and_target_value" g_menu_item_set_action_and_target_value :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" CString -> -- action : TBasicType TUTF8 Ptr GVariant -> -- target_value : TVariant IO () menuItemSetActionAndTargetValue :: (MonadIO m, MenuItemK a) => a -> -- _obj Maybe (T.Text) -> -- action Maybe (GVariant) -> -- target_value m () menuItemSetActionAndTargetValue _obj action target_value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeAction <- case action of Nothing -> return nullPtr Just jAction -> do jAction' <- textToCString jAction return jAction' maybeTarget_value <- case target_value of Nothing -> return nullPtr Just jTarget_value -> do let jTarget_value' = unsafeManagedPtrGetPtr jTarget_value return jTarget_value' g_menu_item_set_action_and_target_value _obj' maybeAction maybeTarget_value touchManagedPtr _obj freeMem maybeAction return () -- method MenuItem::set_attribute_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_item_set_attribute_value" g_menu_item_set_attribute_value :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" CString -> -- attribute : TBasicType TUTF8 Ptr GVariant -> -- value : TVariant IO () menuItemSetAttributeValue :: (MonadIO m, MenuItemK a) => a -> -- _obj T.Text -> -- attribute Maybe (GVariant) -> -- value m () menuItemSetAttributeValue _obj attribute value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do let jValue' = unsafeManagedPtrGetPtr jValue return jValue' g_menu_item_set_attribute_value _obj' attribute' maybeValue touchManagedPtr _obj freeMem attribute' return () -- method MenuItem::set_detailed_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", 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_menu_item_set_detailed_action" g_menu_item_set_detailed_action :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" CString -> -- detailed_action : TBasicType TUTF8 IO () menuItemSetDetailedAction :: (MonadIO m, MenuItemK a) => a -> -- _obj T.Text -> -- detailed_action m () menuItemSetDetailedAction _obj detailed_action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj detailed_action' <- textToCString detailed_action g_menu_item_set_detailed_action _obj' detailed_action' touchManagedPtr _obj freeMem detailed_action' return () -- method MenuItem::set_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_item_set_icon" g_menu_item_set_icon :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" Ptr Icon -> -- icon : TInterface "Gio" "Icon" IO () menuItemSetIcon :: (MonadIO m, MenuItemK a, IconK b) => a -> -- _obj b -> -- icon m () menuItemSetIcon _obj icon = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let icon' = unsafeManagedPtrCastPtr icon g_menu_item_set_icon _obj' icon' touchManagedPtr _obj touchManagedPtr icon return () -- method MenuItem::set_label -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", 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_menu_item_set_label" g_menu_item_set_label :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" CString -> -- label : TBasicType TUTF8 IO () menuItemSetLabel :: (MonadIO m, MenuItemK a) => a -> -- _obj Maybe (T.Text) -> -- label m () menuItemSetLabel _obj label = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLabel <- case label of Nothing -> return nullPtr Just jLabel -> do jLabel' <- textToCString jLabel return jLabel' g_menu_item_set_label _obj' maybeLabel touchManagedPtr _obj freeMem maybeLabel return () -- method MenuItem::set_link -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "link", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "model", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "link", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "model", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_item_set_link" g_menu_item_set_link :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" CString -> -- link : TBasicType TUTF8 Ptr MenuModel -> -- model : TInterface "Gio" "MenuModel" IO () menuItemSetLink :: (MonadIO m, MenuItemK a, MenuModelK b) => a -> -- _obj T.Text -> -- link Maybe (b) -> -- model m () menuItemSetLink _obj link model = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj link' <- textToCString link maybeModel <- case model of Nothing -> return nullPtr Just jModel -> do let jModel' = unsafeManagedPtrCastPtr jModel return jModel' g_menu_item_set_link _obj' link' maybeModel touchManagedPtr _obj whenJust model touchManagedPtr freeMem link' return () -- method MenuItem::set_section -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "section", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_item_set_section" g_menu_item_set_section :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" Ptr MenuModel -> -- section : TInterface "Gio" "MenuModel" IO () menuItemSetSection :: (MonadIO m, MenuItemK a, MenuModelK b) => a -> -- _obj Maybe (b) -> -- section m () menuItemSetSection _obj section = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeSection <- case section of Nothing -> return nullPtr Just jSection -> do let jSection' = unsafeManagedPtrCastPtr jSection return jSection' g_menu_item_set_section _obj' maybeSection touchManagedPtr _obj whenJust section touchManagedPtr return () -- method MenuItem::set_submenu -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "submenu", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_menu_item_set_submenu" g_menu_item_set_submenu :: Ptr MenuItem -> -- _obj : TInterface "Gio" "MenuItem" Ptr MenuModel -> -- submenu : TInterface "Gio" "MenuModel" IO () menuItemSetSubmenu :: (MonadIO m, MenuItemK a, MenuModelK b) => a -> -- _obj Maybe (b) -> -- submenu m () menuItemSetSubmenu _obj submenu = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeSubmenu <- case submenu of Nothing -> return nullPtr Just jSubmenu -> do let jSubmenu' = unsafeManagedPtrCastPtr jSubmenu return jSubmenu' g_menu_item_set_submenu _obj' maybeSubmenu touchManagedPtr _obj whenJust submenu touchManagedPtr return () -- object MenuLinkIter newtype MenuLinkIter = MenuLinkIter (ForeignPtr MenuLinkIter) noMenuLinkIter :: Maybe MenuLinkIter noMenuLinkIter = Nothing foreign import ccall "g_menu_link_iter_get_type" c_g_menu_link_iter_get_type :: IO GType type instance ParentTypes MenuLinkIter = '[GObject.Object] instance GObject MenuLinkIter where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_menu_link_iter_get_type class GObject o => MenuLinkIterK o instance (GObject o, IsDescendantOf MenuLinkIter o) => MenuLinkIterK o toMenuLinkIter :: MenuLinkIterK o => o -> IO MenuLinkIter toMenuLinkIter = unsafeCastTo MenuLinkIter -- method MenuLinkIter::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuLinkIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuLinkIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_menu_link_iter_get_name" g_menu_link_iter_get_name :: Ptr MenuLinkIter -> -- _obj : TInterface "Gio" "MenuLinkIter" IO CString menuLinkIterGetName :: (MonadIO m, MenuLinkIterK a) => a -> -- _obj m T.Text menuLinkIterGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_link_iter_get_name _obj' checkUnexpectedReturnNULL "g_menu_link_iter_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method MenuLinkIter::get_next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuLinkIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_link", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "Gio" "MenuModel", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuLinkIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_menu_link_iter_get_next" g_menu_link_iter_get_next :: Ptr MenuLinkIter -> -- _obj : TInterface "Gio" "MenuLinkIter" Ptr CString -> -- out_link : TBasicType TUTF8 Ptr (Ptr MenuModel) -> -- value : TInterface "Gio" "MenuModel" IO CInt menuLinkIterGetNext :: (MonadIO m, MenuLinkIterK a) => a -> -- _obj m (Bool,T.Text,MenuModel) menuLinkIterGetNext _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj out_link <- allocMem :: IO (Ptr CString) value <- allocMem :: IO (Ptr (Ptr MenuModel)) result <- g_menu_link_iter_get_next _obj' out_link value let result' = (/= 0) result out_link' <- peek out_link out_link'' <- cstringToText out_link' value' <- peek value value'' <- (wrapObject MenuModel) value' touchManagedPtr _obj freeMem out_link freeMem value return (result', out_link'', value'') -- method MenuLinkIter::get_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuLinkIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuLinkIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuModel" -- throws : False -- Skip return : False foreign import ccall "g_menu_link_iter_get_value" g_menu_link_iter_get_value :: Ptr MenuLinkIter -> -- _obj : TInterface "Gio" "MenuLinkIter" IO (Ptr MenuModel) menuLinkIterGetValue :: (MonadIO m, MenuLinkIterK a) => a -> -- _obj m MenuModel menuLinkIterGetValue _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_link_iter_get_value _obj' checkUnexpectedReturnNULL "g_menu_link_iter_get_value" result result' <- (wrapObject MenuModel) result touchManagedPtr _obj return result' -- method MenuLinkIter::next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuLinkIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuLinkIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_menu_link_iter_next" g_menu_link_iter_next :: Ptr MenuLinkIter -> -- _obj : TInterface "Gio" "MenuLinkIter" IO CInt menuLinkIterNext :: (MonadIO m, MenuLinkIterK a) => a -> -- _obj m Bool menuLinkIterNext _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_link_iter_next _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- object MenuModel newtype MenuModel = MenuModel (ForeignPtr MenuModel) noMenuModel :: Maybe MenuModel noMenuModel = Nothing foreign import ccall "g_menu_model_get_type" c_g_menu_model_get_type :: IO GType type instance ParentTypes MenuModel = '[GObject.Object] instance GObject MenuModel where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_menu_model_get_type class GObject o => MenuModelK o instance (GObject o, IsDescendantOf MenuModel o) => MenuModelK o toMenuModel :: MenuModelK o => o -> IO MenuModel toMenuModel = unsafeCastTo MenuModel -- method MenuModel::get_item_attribute_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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 "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attribute", 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_menu_model_get_item_attribute_value" g_menu_model_get_item_attribute_value :: Ptr MenuModel -> -- _obj : TInterface "Gio" "MenuModel" Int32 -> -- item_index : TBasicType TInt32 CString -> -- attribute : TBasicType TUTF8 Ptr GLib.VariantType -> -- expected_type : TInterface "GLib" "VariantType" IO (Ptr GVariant) menuModelGetItemAttributeValue :: (MonadIO m, MenuModelK a) => a -> -- _obj Int32 -> -- item_index T.Text -> -- attribute Maybe (GLib.VariantType) -> -- expected_type m GVariant menuModelGetItemAttributeValue _obj item_index attribute expected_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attribute' <- textToCString attribute maybeExpected_type <- case expected_type of Nothing -> return nullPtr Just jExpected_type -> do let jExpected_type' = unsafeManagedPtrGetPtr jExpected_type return jExpected_type' result <- g_menu_model_get_item_attribute_value _obj' item_index attribute' maybeExpected_type checkUnexpectedReturnNULL "g_menu_model_get_item_attribute_value" result result' <- wrapGVariantPtr result touchManagedPtr _obj whenJust expected_type touchManagedPtr freeMem attribute' return result' -- method MenuModel::get_item_link -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "link", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "link", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuModel" -- throws : False -- Skip return : False foreign import ccall "g_menu_model_get_item_link" g_menu_model_get_item_link :: Ptr MenuModel -> -- _obj : TInterface "Gio" "MenuModel" Int32 -> -- item_index : TBasicType TInt32 CString -> -- link : TBasicType TUTF8 IO (Ptr MenuModel) menuModelGetItemLink :: (MonadIO m, MenuModelK a) => a -> -- _obj Int32 -> -- item_index T.Text -> -- link m MenuModel menuModelGetItemLink _obj item_index link = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj link' <- textToCString link result <- g_menu_model_get_item_link _obj' item_index link' checkUnexpectedReturnNULL "g_menu_model_get_item_link" result result' <- (wrapObject MenuModel) result touchManagedPtr _obj freeMem link' return result' -- method MenuModel::get_n_items -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_menu_model_get_n_items" g_menu_model_get_n_items :: Ptr MenuModel -> -- _obj : TInterface "Gio" "MenuModel" IO Int32 menuModelGetNItems :: (MonadIO m, MenuModelK a) => a -> -- _obj m Int32 menuModelGetNItems _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_model_get_n_items _obj' touchManagedPtr _obj return result -- method MenuModel::is_mutable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_menu_model_is_mutable" g_menu_model_is_mutable :: Ptr MenuModel -> -- _obj : TInterface "Gio" "MenuModel" IO CInt menuModelIsMutable :: (MonadIO m, MenuModelK a) => a -> -- _obj m Bool menuModelIsMutable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_model_is_mutable _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MenuModel::items_changed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "removed", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "added", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "removed", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "added", 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_menu_model_items_changed" g_menu_model_items_changed :: Ptr MenuModel -> -- _obj : TInterface "Gio" "MenuModel" Int32 -> -- position : TBasicType TInt32 Int32 -> -- removed : TBasicType TInt32 Int32 -> -- added : TBasicType TInt32 IO () menuModelItemsChanged :: (MonadIO m, MenuModelK a) => a -> -- _obj Int32 -> -- position Int32 -> -- removed Int32 -> -- added m () menuModelItemsChanged _obj position removed added = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_menu_model_items_changed _obj' position removed added touchManagedPtr _obj return () -- method MenuModel::iterate_item_attributes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuAttributeIter" -- throws : False -- Skip return : False foreign import ccall "g_menu_model_iterate_item_attributes" g_menu_model_iterate_item_attributes :: Ptr MenuModel -> -- _obj : TInterface "Gio" "MenuModel" Int32 -> -- item_index : TBasicType TInt32 IO (Ptr MenuAttributeIter) menuModelIterateItemAttributes :: (MonadIO m, MenuModelK a) => a -> -- _obj Int32 -> -- item_index m MenuAttributeIter menuModelIterateItemAttributes _obj item_index = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_model_iterate_item_attributes _obj' item_index checkUnexpectedReturnNULL "g_menu_model_iterate_item_attributes" result result' <- (wrapObject MenuAttributeIter) result touchManagedPtr _obj return result' -- method MenuModel::iterate_item_links -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MenuModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "MenuLinkIter" -- throws : False -- Skip return : False foreign import ccall "g_menu_model_iterate_item_links" g_menu_model_iterate_item_links :: Ptr MenuModel -> -- _obj : TInterface "Gio" "MenuModel" Int32 -> -- item_index : TBasicType TInt32 IO (Ptr MenuLinkIter) menuModelIterateItemLinks :: (MonadIO m, MenuModelK a) => a -> -- _obj Int32 -> -- item_index m MenuLinkIter menuModelIterateItemLinks _obj item_index = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_menu_model_iterate_item_links _obj' item_index checkUnexpectedReturnNULL "g_menu_model_iterate_item_links" result result' <- (wrapObject MenuLinkIter) result touchManagedPtr _obj return result' -- signal MenuModel::items-changed type MenuModelItemsChangedCallback = Int32 -> Int32 -> Int32 -> IO () noMenuModelItemsChangedCallback :: Maybe MenuModelItemsChangedCallback noMenuModelItemsChangedCallback = Nothing type MenuModelItemsChangedCallbackC = Ptr () -> -- object Int32 -> Int32 -> Int32 -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMenuModelItemsChangedCallback :: MenuModelItemsChangedCallbackC -> IO (FunPtr MenuModelItemsChangedCallbackC) menuModelItemsChangedClosure :: MenuModelItemsChangedCallback -> IO Closure menuModelItemsChangedClosure cb = newCClosure =<< mkMenuModelItemsChangedCallback wrapped where wrapped = menuModelItemsChangedCallbackWrapper cb menuModelItemsChangedCallbackWrapper :: MenuModelItemsChangedCallback -> Ptr () -> Int32 -> Int32 -> Int32 -> Ptr () -> IO () menuModelItemsChangedCallbackWrapper _cb _ position removed added _ = do _cb position removed added onMenuModelItemsChanged :: (GObject a, MonadIO m) => a -> MenuModelItemsChangedCallback -> m SignalHandlerId onMenuModelItemsChanged obj cb = liftIO $ connectMenuModelItemsChanged obj cb SignalConnectBefore afterMenuModelItemsChanged :: (GObject a, MonadIO m) => a -> MenuModelItemsChangedCallback -> m SignalHandlerId afterMenuModelItemsChanged obj cb = connectMenuModelItemsChanged obj cb SignalConnectAfter connectMenuModelItemsChanged :: (GObject a, MonadIO m) => a -> MenuModelItemsChangedCallback -> SignalConnectMode -> m SignalHandlerId connectMenuModelItemsChanged obj cb after = liftIO $ do cb' <- mkMenuModelItemsChangedCallback (menuModelItemsChangedCallbackWrapper cb) connectSignalFunPtr obj "items-changed" cb' after -- interface Mount newtype Mount = Mount (ForeignPtr Mount) noMount :: Maybe Mount noMount = Nothing foreign import ccall "g_mount_get_type" c_g_mount_get_type :: IO GType type instance ParentTypes Mount = '[GObject.Object] instance GObject Mount where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_mount_get_type class GObject o => MountK o instance (GObject o, IsDescendantOf Mount o) => MountK o toMount :: MountK o => o -> IO Mount toMount = unsafeCastTo Mount -- method Mount::can_eject -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_mount_can_eject" g_mount_can_eject :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO CInt mountCanEject :: (MonadIO m, MountK a) => a -> -- _obj m Bool mountCanEject _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_can_eject _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Mount::can_unmount -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_mount_can_unmount" g_mount_can_unmount :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO CInt mountCanUnmount :: (MonadIO m, MountK a) => a -> -- _obj m Bool mountCanUnmount _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_can_unmount _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Mount::eject -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_eject" g_mount_eject :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () {-# DEPRECATED mountEject ["(Since version 2.22)","Use g_mount_eject_with_operation() instead."]#-} mountEject :: (MonadIO m, MountK a, CancellableK b) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () mountEject _obj flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_mount_eject _obj' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Mount::eject_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_mount_eject_finish" g_mount_eject_finish :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt {-# DEPRECATED mountEjectFinish ["(Since version 2.22)","Use g_mount_eject_with_operation_finish() instead."]#-} mountEjectFinish :: (MonadIO m, MountK a, AsyncResultK b) => a -> -- _obj b -> -- result m () mountEjectFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_mount_eject_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Mount::eject_with_operation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_eject_with_operation" g_mount_eject_with_operation :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () mountEjectWithOperation :: (MonadIO m, MountK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () mountEjectWithOperation _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_mount_eject_with_operation _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Mount::eject_with_operation_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_mount_eject_with_operation_finish" g_mount_eject_with_operation_finish :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt mountEjectWithOperationFinish :: (MonadIO m, MountK a, AsyncResultK b) => a -> -- _obj b -> -- result m () mountEjectWithOperationFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_mount_eject_with_operation_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Mount::get_default_location -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_mount_get_default_location" g_mount_get_default_location :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO (Ptr File) mountGetDefaultLocation :: (MonadIO m, MountK a) => a -> -- _obj m File mountGetDefaultLocation _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_default_location _obj' checkUnexpectedReturnNULL "g_mount_get_default_location" result result' <- (wrapObject File) result touchManagedPtr _obj return result' -- method Mount::get_drive -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Drive" -- throws : False -- Skip return : False foreign import ccall "g_mount_get_drive" g_mount_get_drive :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO (Ptr Drive) mountGetDrive :: (MonadIO m, MountK a) => a -> -- _obj m Drive mountGetDrive _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_drive _obj' checkUnexpectedReturnNULL "g_mount_get_drive" result result' <- (wrapObject Drive) result touchManagedPtr _obj return result' -- method Mount::get_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_mount_get_icon" g_mount_get_icon :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO (Ptr Icon) mountGetIcon :: (MonadIO m, MountK a) => a -> -- _obj m Icon mountGetIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_icon _obj' checkUnexpectedReturnNULL "g_mount_get_icon" result result' <- (wrapObject Icon) result touchManagedPtr _obj return result' -- method Mount::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_mount_get_name" g_mount_get_name :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO CString mountGetName :: (MonadIO m, MountK a) => a -> -- _obj m T.Text mountGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_name _obj' checkUnexpectedReturnNULL "g_mount_get_name" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method Mount::get_root -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_mount_get_root" g_mount_get_root :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO (Ptr File) mountGetRoot :: (MonadIO m, MountK a) => a -> -- _obj m File mountGetRoot _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_root _obj' checkUnexpectedReturnNULL "g_mount_get_root" result result' <- (wrapObject File) result touchManagedPtr _obj return result' -- method Mount::get_sort_key -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_mount_get_sort_key" g_mount_get_sort_key :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO CString mountGetSortKey :: (MonadIO m, MountK a) => a -> -- _obj m T.Text mountGetSortKey _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_sort_key _obj' checkUnexpectedReturnNULL "g_mount_get_sort_key" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Mount::get_symbolic_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_mount_get_symbolic_icon" g_mount_get_symbolic_icon :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO (Ptr Icon) mountGetSymbolicIcon :: (MonadIO m, MountK a) => a -> -- _obj m Icon mountGetSymbolicIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_symbolic_icon _obj' checkUnexpectedReturnNULL "g_mount_get_symbolic_icon" result result' <- (wrapObject Icon) result touchManagedPtr _obj return result' -- method Mount::get_uuid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_mount_get_uuid" g_mount_get_uuid :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO CString mountGetUuid :: (MonadIO m, MountK a) => a -> -- _obj m T.Text mountGetUuid _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_uuid _obj' checkUnexpectedReturnNULL "g_mount_get_uuid" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method Mount::get_volume -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Volume" -- throws : False -- Skip return : False foreign import ccall "g_mount_get_volume" g_mount_get_volume :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO (Ptr Volume) mountGetVolume :: (MonadIO m, MountK a) => a -> -- _obj m Volume mountGetVolume _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_get_volume _obj' checkUnexpectedReturnNULL "g_mount_get_volume" result result' <- (wrapObject Volume) result touchManagedPtr _obj return result' -- method Mount::guess_content_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "force_rescan", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "force_rescan", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_guess_content_type" g_mount_guess_content_type :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" CInt -> -- force_rescan : TBasicType TBoolean Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () mountGuessContentType :: (MonadIO m, MountK a, CancellableK b) => a -> -- _obj Bool -> -- force_rescan Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () mountGuessContentType _obj force_rescan cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let force_rescan' = (fromIntegral . fromEnum) force_rescan maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_mount_guess_content_type _obj' force_rescan' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Mount::guess_content_type_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_mount_guess_content_type_finish" g_mount_guess_content_type_finish :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr CString) mountGuessContentTypeFinish :: (MonadIO m, MountK a, AsyncResultK b) => a -> -- _obj b -> -- result m [T.Text] mountGuessContentTypeFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_mount_guess_content_type_finish _obj' result_' checkUnexpectedReturnNULL "g_mount_guess_content_type_finish" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method Mount::guess_content_type_sync -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "force_rescan", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "force_rescan", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : True -- Skip return : False foreign import ccall "g_mount_guess_content_type_sync" g_mount_guess_content_type_sync :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" CInt -> -- force_rescan : TBasicType TBoolean Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr CString) mountGuessContentTypeSync :: (MonadIO m, MountK a, CancellableK b) => a -> -- _obj Bool -> -- force_rescan Maybe (b) -> -- cancellable m [T.Text] mountGuessContentTypeSync _obj force_rescan cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let force_rescan' = (fromIntegral . fromEnum) force_rescan maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_mount_guess_content_type_sync _obj' force_rescan' maybeCancellable checkUnexpectedReturnNULL "g_mount_guess_content_type_sync" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method Mount::is_shadowed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_mount_is_shadowed" g_mount_is_shadowed :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO CInt mountIsShadowed :: (MonadIO m, MountK a) => a -> -- _obj m Bool mountIsShadowed _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_is_shadowed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Mount::remount -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountMountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountMountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_remount" g_mount_remount :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" CUInt -> -- flags : TInterface "Gio" "MountMountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () mountRemount :: (MonadIO m, MountK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountMountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () mountRemount _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_mount_remount _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Mount::remount_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_mount_remount_finish" g_mount_remount_finish :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt mountRemountFinish :: (MonadIO m, MountK a, AsyncResultK b) => a -> -- _obj b -> -- result m () mountRemountFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_mount_remount_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Mount::shadow -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_shadow" g_mount_shadow :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO () mountShadow :: (MonadIO m, MountK a) => a -> -- _obj m () mountShadow _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_mount_shadow _obj' touchManagedPtr _obj return () -- method Mount::unmount -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_unmount" g_mount_unmount :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () {-# DEPRECATED mountUnmount ["(Since version 2.22)","Use g_mount_unmount_with_operation() instead."]#-} mountUnmount :: (MonadIO m, MountK a, CancellableK b) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () mountUnmount _obj flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_mount_unmount _obj' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Mount::unmount_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_mount_unmount_finish" g_mount_unmount_finish :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt {-# DEPRECATED mountUnmountFinish ["(Since version 2.22)","Use g_mount_unmount_with_operation_finish() instead."]#-} mountUnmountFinish :: (MonadIO m, MountK a, AsyncResultK b) => a -> -- _obj b -> -- result m () mountUnmountFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_mount_unmount_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Mount::unmount_with_operation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_unmount_with_operation" g_mount_unmount_with_operation :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () mountUnmountWithOperation :: (MonadIO m, MountK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () mountUnmountWithOperation _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_mount_unmount_with_operation _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Mount::unmount_with_operation_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_mount_unmount_with_operation_finish" g_mount_unmount_with_operation_finish :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt mountUnmountWithOperationFinish :: (MonadIO m, MountK a, AsyncResultK b) => a -> -- _obj b -> -- result m () mountUnmountWithOperationFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_mount_unmount_with_operation_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Mount::unshadow -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_unshadow" g_mount_unshadow :: Ptr Mount -> -- _obj : TInterface "Gio" "Mount" IO () mountUnshadow :: (MonadIO m, MountK a) => a -> -- _obj m () mountUnshadow _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_mount_unshadow _obj' touchManagedPtr _obj return () -- signal Mount::changed type MountChangedCallback = IO () noMountChangedCallback :: Maybe MountChangedCallback noMountChangedCallback = Nothing type MountChangedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountChangedCallback :: MountChangedCallbackC -> IO (FunPtr MountChangedCallbackC) mountChangedClosure :: MountChangedCallback -> IO Closure mountChangedClosure cb = newCClosure =<< mkMountChangedCallback wrapped where wrapped = mountChangedCallbackWrapper cb mountChangedCallbackWrapper :: MountChangedCallback -> Ptr () -> Ptr () -> IO () mountChangedCallbackWrapper _cb _ _ = do _cb onMountChanged :: (GObject a, MonadIO m) => a -> MountChangedCallback -> m SignalHandlerId onMountChanged obj cb = liftIO $ connectMountChanged obj cb SignalConnectBefore afterMountChanged :: (GObject a, MonadIO m) => a -> MountChangedCallback -> m SignalHandlerId afterMountChanged obj cb = connectMountChanged obj cb SignalConnectAfter connectMountChanged :: (GObject a, MonadIO m) => a -> MountChangedCallback -> SignalConnectMode -> m SignalHandlerId connectMountChanged obj cb after = liftIO $ do cb' <- mkMountChangedCallback (mountChangedCallbackWrapper cb) connectSignalFunPtr obj "changed" cb' after -- signal Mount::pre-unmount type MountPreUnmountCallback = IO () noMountPreUnmountCallback :: Maybe MountPreUnmountCallback noMountPreUnmountCallback = Nothing type MountPreUnmountCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountPreUnmountCallback :: MountPreUnmountCallbackC -> IO (FunPtr MountPreUnmountCallbackC) mountPreUnmountClosure :: MountPreUnmountCallback -> IO Closure mountPreUnmountClosure cb = newCClosure =<< mkMountPreUnmountCallback wrapped where wrapped = mountPreUnmountCallbackWrapper cb mountPreUnmountCallbackWrapper :: MountPreUnmountCallback -> Ptr () -> Ptr () -> IO () mountPreUnmountCallbackWrapper _cb _ _ = do _cb onMountPreUnmount :: (GObject a, MonadIO m) => a -> MountPreUnmountCallback -> m SignalHandlerId onMountPreUnmount obj cb = liftIO $ connectMountPreUnmount obj cb SignalConnectBefore afterMountPreUnmount :: (GObject a, MonadIO m) => a -> MountPreUnmountCallback -> m SignalHandlerId afterMountPreUnmount obj cb = connectMountPreUnmount obj cb SignalConnectAfter connectMountPreUnmount :: (GObject a, MonadIO m) => a -> MountPreUnmountCallback -> SignalConnectMode -> m SignalHandlerId connectMountPreUnmount obj cb after = liftIO $ do cb' <- mkMountPreUnmountCallback (mountPreUnmountCallbackWrapper cb) connectSignalFunPtr obj "pre-unmount" cb' after -- signal Mount::unmounted type MountUnmountedCallback = IO () noMountUnmountedCallback :: Maybe MountUnmountedCallback noMountUnmountedCallback = Nothing type MountUnmountedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountUnmountedCallback :: MountUnmountedCallbackC -> IO (FunPtr MountUnmountedCallbackC) mountUnmountedClosure :: MountUnmountedCallback -> IO Closure mountUnmountedClosure cb = newCClosure =<< mkMountUnmountedCallback wrapped where wrapped = mountUnmountedCallbackWrapper cb mountUnmountedCallbackWrapper :: MountUnmountedCallback -> Ptr () -> Ptr () -> IO () mountUnmountedCallbackWrapper _cb _ _ = do _cb onMountUnmounted :: (GObject a, MonadIO m) => a -> MountUnmountedCallback -> m SignalHandlerId onMountUnmounted obj cb = liftIO $ connectMountUnmounted obj cb SignalConnectBefore afterMountUnmounted :: (GObject a, MonadIO m) => a -> MountUnmountedCallback -> m SignalHandlerId afterMountUnmounted obj cb = connectMountUnmounted obj cb SignalConnectAfter connectMountUnmounted :: (GObject a, MonadIO m) => a -> MountUnmountedCallback -> SignalConnectMode -> m SignalHandlerId connectMountUnmounted obj cb after = liftIO $ do cb' <- mkMountUnmountedCallback (mountUnmountedCallbackWrapper cb) connectSignalFunPtr obj "unmounted" cb' after -- Flags MountMountFlags data MountMountFlags = MountMountFlagsNone | AnotherMountMountFlags Int deriving (Show, Eq) instance Enum MountMountFlags where fromEnum MountMountFlagsNone = 0 fromEnum (AnotherMountMountFlags k) = k toEnum 0 = MountMountFlagsNone toEnum k = AnotherMountMountFlags k foreign import ccall "g_mount_mount_flags_get_type" c_g_mount_mount_flags_get_type :: IO GType instance BoxedEnum MountMountFlags where boxedEnumType _ = c_g_mount_mount_flags_get_type instance IsGFlag MountMountFlags -- object MountOperation newtype MountOperation = MountOperation (ForeignPtr MountOperation) noMountOperation :: Maybe MountOperation noMountOperation = Nothing foreign import ccall "g_mount_operation_get_type" c_g_mount_operation_get_type :: IO GType type instance ParentTypes MountOperation = '[GObject.Object] instance GObject MountOperation where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_mount_operation_get_type class GObject o => MountOperationK o instance (GObject o, IsDescendantOf MountOperation o) => MountOperationK o toMountOperation :: MountOperationK o => o -> IO MountOperation toMountOperation = unsafeCastTo MountOperation -- method MountOperation::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "MountOperation" -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_new" g_mount_operation_new :: IO (Ptr MountOperation) mountOperationNew :: (MonadIO m) => m MountOperation mountOperationNew = liftIO $ do result <- g_mount_operation_new checkUnexpectedReturnNULL "g_mount_operation_new" result result' <- (wrapObject MountOperation) result return result' -- method MountOperation::get_anonymous -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_get_anonymous" g_mount_operation_get_anonymous :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" IO CInt mountOperationGetAnonymous :: (MonadIO m, MountOperationK a) => a -> -- _obj m Bool mountOperationGetAnonymous _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_operation_get_anonymous _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method MountOperation::get_choice -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_get_choice" g_mount_operation_get_choice :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" IO Int32 mountOperationGetChoice :: (MonadIO m, MountOperationK a) => a -> -- _obj m Int32 mountOperationGetChoice _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_operation_get_choice _obj' touchManagedPtr _obj return result -- method MountOperation::get_domain -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_get_domain" g_mount_operation_get_domain :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" IO CString mountOperationGetDomain :: (MonadIO m, MountOperationK a) => a -> -- _obj m T.Text mountOperationGetDomain _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_operation_get_domain _obj' checkUnexpectedReturnNULL "g_mount_operation_get_domain" result result' <- cstringToText result touchManagedPtr _obj return result' -- method MountOperation::get_password -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_get_password" g_mount_operation_get_password :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" IO CString mountOperationGetPassword :: (MonadIO m, MountOperationK a) => a -> -- _obj m T.Text mountOperationGetPassword _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_operation_get_password _obj' checkUnexpectedReturnNULL "g_mount_operation_get_password" result result' <- cstringToText result touchManagedPtr _obj return result' -- method MountOperation::get_password_save -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "PasswordSave" -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_get_password_save" g_mount_operation_get_password_save :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" IO CUInt mountOperationGetPasswordSave :: (MonadIO m, MountOperationK a) => a -> -- _obj m PasswordSave mountOperationGetPasswordSave _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_operation_get_password_save _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method MountOperation::get_username -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_get_username" g_mount_operation_get_username :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" IO CString mountOperationGetUsername :: (MonadIO m, MountOperationK a) => a -> -- _obj m T.Text mountOperationGetUsername _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_mount_operation_get_username _obj' checkUnexpectedReturnNULL "g_mount_operation_get_username" result result' <- cstringToText result touchManagedPtr _obj return result' -- method MountOperation::reply -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "MountOperationResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "MountOperationResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_reply" g_mount_operation_reply :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" CUInt -> -- result : TInterface "Gio" "MountOperationResult" IO () mountOperationReply :: (MonadIO m, MountOperationK a) => a -> -- _obj MountOperationResult -> -- result m () mountOperationReply _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = (fromIntegral . fromEnum) result_ g_mount_operation_reply _obj' result_' touchManagedPtr _obj return () -- method MountOperation::set_anonymous -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "anonymous", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "anonymous", 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_mount_operation_set_anonymous" g_mount_operation_set_anonymous :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" CInt -> -- anonymous : TBasicType TBoolean IO () mountOperationSetAnonymous :: (MonadIO m, MountOperationK a) => a -> -- _obj Bool -> -- anonymous m () mountOperationSetAnonymous _obj anonymous = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let anonymous' = (fromIntegral . fromEnum) anonymous g_mount_operation_set_anonymous _obj' anonymous' touchManagedPtr _obj return () -- method MountOperation::set_choice -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "choice", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "choice", 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_mount_operation_set_choice" g_mount_operation_set_choice :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" Int32 -> -- choice : TBasicType TInt32 IO () mountOperationSetChoice :: (MonadIO m, MountOperationK a) => a -> -- _obj Int32 -> -- choice m () mountOperationSetChoice _obj choice = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_mount_operation_set_choice _obj' choice touchManagedPtr _obj return () -- method MountOperation::set_domain -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", 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 "Gio" "MountOperation", 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_mount_operation_set_domain" g_mount_operation_set_domain :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" CString -> -- domain : TBasicType TUTF8 IO () mountOperationSetDomain :: (MonadIO m, MountOperationK a) => a -> -- _obj T.Text -> -- domain m () mountOperationSetDomain _obj domain = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj domain' <- textToCString domain g_mount_operation_set_domain _obj' domain' touchManagedPtr _obj freeMem domain' return () -- method MountOperation::set_password -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", 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_mount_operation_set_password" g_mount_operation_set_password :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" CString -> -- password : TBasicType TUTF8 IO () mountOperationSetPassword :: (MonadIO m, MountOperationK a) => a -> -- _obj T.Text -> -- password m () mountOperationSetPassword _obj password = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj password' <- textToCString password g_mount_operation_set_password _obj' password' touchManagedPtr _obj freeMem password' return () -- method MountOperation::set_password_save -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "save", argType = TInterface "Gio" "PasswordSave", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "save", argType = TInterface "Gio" "PasswordSave", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_mount_operation_set_password_save" g_mount_operation_set_password_save :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" CUInt -> -- save : TInterface "Gio" "PasswordSave" IO () mountOperationSetPasswordSave :: (MonadIO m, MountOperationK a) => a -> -- _obj PasswordSave -> -- save m () mountOperationSetPasswordSave _obj save = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let save' = (fromIntegral . fromEnum) save g_mount_operation_set_password_save _obj' save' touchManagedPtr _obj return () -- method MountOperation::set_username -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "username", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "username", 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_mount_operation_set_username" g_mount_operation_set_username :: Ptr MountOperation -> -- _obj : TInterface "Gio" "MountOperation" CString -> -- username : TBasicType TUTF8 IO () mountOperationSetUsername :: (MonadIO m, MountOperationK a) => a -> -- _obj T.Text -> -- username m () mountOperationSetUsername _obj username = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj username' <- textToCString username g_mount_operation_set_username _obj' username' touchManagedPtr _obj freeMem username' return () -- signal MountOperation::aborted type MountOperationAbortedCallback = IO () noMountOperationAbortedCallback :: Maybe MountOperationAbortedCallback noMountOperationAbortedCallback = Nothing type MountOperationAbortedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountOperationAbortedCallback :: MountOperationAbortedCallbackC -> IO (FunPtr MountOperationAbortedCallbackC) mountOperationAbortedClosure :: MountOperationAbortedCallback -> IO Closure mountOperationAbortedClosure cb = newCClosure =<< mkMountOperationAbortedCallback wrapped where wrapped = mountOperationAbortedCallbackWrapper cb mountOperationAbortedCallbackWrapper :: MountOperationAbortedCallback -> Ptr () -> Ptr () -> IO () mountOperationAbortedCallbackWrapper _cb _ _ = do _cb onMountOperationAborted :: (GObject a, MonadIO m) => a -> MountOperationAbortedCallback -> m SignalHandlerId onMountOperationAborted obj cb = liftIO $ connectMountOperationAborted obj cb SignalConnectBefore afterMountOperationAborted :: (GObject a, MonadIO m) => a -> MountOperationAbortedCallback -> m SignalHandlerId afterMountOperationAborted obj cb = connectMountOperationAborted obj cb SignalConnectAfter connectMountOperationAborted :: (GObject a, MonadIO m) => a -> MountOperationAbortedCallback -> SignalConnectMode -> m SignalHandlerId connectMountOperationAborted obj cb after = liftIO $ do cb' <- mkMountOperationAbortedCallback (mountOperationAbortedCallbackWrapper cb) connectSignalFunPtr obj "aborted" cb' after -- signal MountOperation::ask-password type MountOperationAskPasswordCallback = T.Text -> T.Text -> T.Text -> [AskPasswordFlags] -> IO () noMountOperationAskPasswordCallback :: Maybe MountOperationAskPasswordCallback noMountOperationAskPasswordCallback = Nothing type MountOperationAskPasswordCallbackC = Ptr () -> -- object CString -> CString -> CString -> CUInt -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountOperationAskPasswordCallback :: MountOperationAskPasswordCallbackC -> IO (FunPtr MountOperationAskPasswordCallbackC) mountOperationAskPasswordClosure :: MountOperationAskPasswordCallback -> IO Closure mountOperationAskPasswordClosure cb = newCClosure =<< mkMountOperationAskPasswordCallback wrapped where wrapped = mountOperationAskPasswordCallbackWrapper cb mountOperationAskPasswordCallbackWrapper :: MountOperationAskPasswordCallback -> Ptr () -> CString -> CString -> CString -> CUInt -> Ptr () -> IO () mountOperationAskPasswordCallbackWrapper _cb _ message default_user default_domain flags _ = do message' <- cstringToText message default_user' <- cstringToText default_user default_domain' <- cstringToText default_domain let flags' = wordToGFlags flags _cb message' default_user' default_domain' flags' onMountOperationAskPassword :: (GObject a, MonadIO m) => a -> MountOperationAskPasswordCallback -> m SignalHandlerId onMountOperationAskPassword obj cb = liftIO $ connectMountOperationAskPassword obj cb SignalConnectBefore afterMountOperationAskPassword :: (GObject a, MonadIO m) => a -> MountOperationAskPasswordCallback -> m SignalHandlerId afterMountOperationAskPassword obj cb = connectMountOperationAskPassword obj cb SignalConnectAfter connectMountOperationAskPassword :: (GObject a, MonadIO m) => a -> MountOperationAskPasswordCallback -> SignalConnectMode -> m SignalHandlerId connectMountOperationAskPassword obj cb after = liftIO $ do cb' <- mkMountOperationAskPasswordCallback (mountOperationAskPasswordCallbackWrapper cb) connectSignalFunPtr obj "ask-password" cb' after -- signal MountOperation::ask-question type MountOperationAskQuestionCallback = T.Text -> [T.Text] -> IO () noMountOperationAskQuestionCallback :: Maybe MountOperationAskQuestionCallback noMountOperationAskQuestionCallback = Nothing type MountOperationAskQuestionCallbackC = Ptr () -> -- object CString -> Ptr CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountOperationAskQuestionCallback :: MountOperationAskQuestionCallbackC -> IO (FunPtr MountOperationAskQuestionCallbackC) mountOperationAskQuestionClosure :: MountOperationAskQuestionCallback -> IO Closure mountOperationAskQuestionClosure cb = newCClosure =<< mkMountOperationAskQuestionCallback wrapped where wrapped = mountOperationAskQuestionCallbackWrapper cb mountOperationAskQuestionCallbackWrapper :: MountOperationAskQuestionCallback -> Ptr () -> CString -> Ptr CString -> Ptr () -> IO () mountOperationAskQuestionCallbackWrapper _cb _ message choices _ = do message' <- cstringToText message choices' <- unpackZeroTerminatedUTF8CArray choices _cb message' choices' onMountOperationAskQuestion :: (GObject a, MonadIO m) => a -> MountOperationAskQuestionCallback -> m SignalHandlerId onMountOperationAskQuestion obj cb = liftIO $ connectMountOperationAskQuestion obj cb SignalConnectBefore afterMountOperationAskQuestion :: (GObject a, MonadIO m) => a -> MountOperationAskQuestionCallback -> m SignalHandlerId afterMountOperationAskQuestion obj cb = connectMountOperationAskQuestion obj cb SignalConnectAfter connectMountOperationAskQuestion :: (GObject a, MonadIO m) => a -> MountOperationAskQuestionCallback -> SignalConnectMode -> m SignalHandlerId connectMountOperationAskQuestion obj cb after = liftIO $ do cb' <- mkMountOperationAskQuestionCallback (mountOperationAskQuestionCallbackWrapper cb) connectSignalFunPtr obj "ask-question" cb' after -- signal MountOperation::reply type MountOperationReplyCallback = MountOperationResult -> IO () noMountOperationReplyCallback :: Maybe MountOperationReplyCallback noMountOperationReplyCallback = Nothing type MountOperationReplyCallbackC = Ptr () -> -- object CUInt -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountOperationReplyCallback :: MountOperationReplyCallbackC -> IO (FunPtr MountOperationReplyCallbackC) mountOperationReplyClosure :: MountOperationReplyCallback -> IO Closure mountOperationReplyClosure cb = newCClosure =<< mkMountOperationReplyCallback wrapped where wrapped = mountOperationReplyCallbackWrapper cb mountOperationReplyCallbackWrapper :: MountOperationReplyCallback -> Ptr () -> CUInt -> Ptr () -> IO () mountOperationReplyCallbackWrapper _cb _ result_ _ = do let result_' = (toEnum . fromIntegral) result_ _cb result_' onMountOperationReply :: (GObject a, MonadIO m) => a -> MountOperationReplyCallback -> m SignalHandlerId onMountOperationReply obj cb = liftIO $ connectMountOperationReply obj cb SignalConnectBefore afterMountOperationReply :: (GObject a, MonadIO m) => a -> MountOperationReplyCallback -> m SignalHandlerId afterMountOperationReply obj cb = connectMountOperationReply obj cb SignalConnectAfter connectMountOperationReply :: (GObject a, MonadIO m) => a -> MountOperationReplyCallback -> SignalConnectMode -> m SignalHandlerId connectMountOperationReply obj cb after = liftIO $ do cb' <- mkMountOperationReplyCallback (mountOperationReplyCallbackWrapper cb) connectSignalFunPtr obj "reply" cb' after -- signal MountOperation::show-processes type MountOperationShowProcessesCallback = T.Text -> [Int32] -> [T.Text] -> IO () noMountOperationShowProcessesCallback :: Maybe MountOperationShowProcessesCallback noMountOperationShowProcessesCallback = Nothing type MountOperationShowProcessesCallbackC = Ptr () -> -- object CString -> Ptr (GArray Int32) -> Ptr CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountOperationShowProcessesCallback :: MountOperationShowProcessesCallbackC -> IO (FunPtr MountOperationShowProcessesCallbackC) mountOperationShowProcessesClosure :: MountOperationShowProcessesCallback -> IO Closure mountOperationShowProcessesClosure cb = newCClosure =<< mkMountOperationShowProcessesCallback wrapped where wrapped = mountOperationShowProcessesCallbackWrapper cb mountOperationShowProcessesCallbackWrapper :: MountOperationShowProcessesCallback -> Ptr () -> CString -> Ptr (GArray Int32) -> Ptr CString -> Ptr () -> IO () mountOperationShowProcessesCallbackWrapper _cb _ message processes choices _ = do message' <- cstringToText message processes' <- unpackGArray processes choices' <- unpackZeroTerminatedUTF8CArray choices _cb message' processes' choices' onMountOperationShowProcesses :: (GObject a, MonadIO m) => a -> MountOperationShowProcessesCallback -> m SignalHandlerId onMountOperationShowProcesses obj cb = liftIO $ connectMountOperationShowProcesses obj cb SignalConnectBefore afterMountOperationShowProcesses :: (GObject a, MonadIO m) => a -> MountOperationShowProcessesCallback -> m SignalHandlerId afterMountOperationShowProcesses obj cb = connectMountOperationShowProcesses obj cb SignalConnectAfter connectMountOperationShowProcesses :: (GObject a, MonadIO m) => a -> MountOperationShowProcessesCallback -> SignalConnectMode -> m SignalHandlerId connectMountOperationShowProcesses obj cb after = liftIO $ do cb' <- mkMountOperationShowProcessesCallback (mountOperationShowProcessesCallbackWrapper cb) connectSignalFunPtr obj "show-processes" cb' after -- signal MountOperation::show-unmount-progress type MountOperationShowUnmountProgressCallback = T.Text -> Int64 -> Int64 -> IO () noMountOperationShowUnmountProgressCallback :: Maybe MountOperationShowUnmountProgressCallback noMountOperationShowUnmountProgressCallback = Nothing type MountOperationShowUnmountProgressCallbackC = Ptr () -> -- object CString -> Int64 -> Int64 -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkMountOperationShowUnmountProgressCallback :: MountOperationShowUnmountProgressCallbackC -> IO (FunPtr MountOperationShowUnmountProgressCallbackC) mountOperationShowUnmountProgressClosure :: MountOperationShowUnmountProgressCallback -> IO Closure mountOperationShowUnmountProgressClosure cb = newCClosure =<< mkMountOperationShowUnmountProgressCallback wrapped where wrapped = mountOperationShowUnmountProgressCallbackWrapper cb mountOperationShowUnmountProgressCallbackWrapper :: MountOperationShowUnmountProgressCallback -> Ptr () -> CString -> Int64 -> Int64 -> Ptr () -> IO () mountOperationShowUnmountProgressCallbackWrapper _cb _ message time_left bytes_left _ = do message' <- cstringToText message _cb message' time_left bytes_left onMountOperationShowUnmountProgress :: (GObject a, MonadIO m) => a -> MountOperationShowUnmountProgressCallback -> m SignalHandlerId onMountOperationShowUnmountProgress obj cb = liftIO $ connectMountOperationShowUnmountProgress obj cb SignalConnectBefore afterMountOperationShowUnmountProgress :: (GObject a, MonadIO m) => a -> MountOperationShowUnmountProgressCallback -> m SignalHandlerId afterMountOperationShowUnmountProgress obj cb = connectMountOperationShowUnmountProgress obj cb SignalConnectAfter connectMountOperationShowUnmountProgress :: (GObject a, MonadIO m) => a -> MountOperationShowUnmountProgressCallback -> SignalConnectMode -> m SignalHandlerId connectMountOperationShowUnmountProgress obj cb after = liftIO $ do cb' <- mkMountOperationShowUnmountProgressCallback (mountOperationShowUnmountProgressCallbackWrapper cb) connectSignalFunPtr obj "show-unmount-progress" cb' after -- Enum MountOperationResult data MountOperationResult = MountOperationResultHandled | MountOperationResultAborted | MountOperationResultUnhandled | AnotherMountOperationResult Int deriving (Show, Eq) instance Enum MountOperationResult where fromEnum MountOperationResultHandled = 0 fromEnum MountOperationResultAborted = 1 fromEnum MountOperationResultUnhandled = 2 fromEnum (AnotherMountOperationResult k) = k toEnum 0 = MountOperationResultHandled toEnum 1 = MountOperationResultAborted toEnum 2 = MountOperationResultUnhandled toEnum k = AnotherMountOperationResult k foreign import ccall "g_mount_operation_result_get_type" c_g_mount_operation_result_get_type :: IO GType instance BoxedEnum MountOperationResult where boxedEnumType _ = c_g_mount_operation_result_get_type -- Flags MountUnmountFlags data MountUnmountFlags = MountUnmountFlagsNone | MountUnmountFlagsForce | AnotherMountUnmountFlags Int deriving (Show, Eq) instance Enum MountUnmountFlags where fromEnum MountUnmountFlagsNone = 0 fromEnum MountUnmountFlagsForce = 1 fromEnum (AnotherMountUnmountFlags k) = k toEnum 0 = MountUnmountFlagsNone toEnum 1 = MountUnmountFlagsForce toEnum k = AnotherMountUnmountFlags k foreign import ccall "g_mount_unmount_flags_get_type" c_g_mount_unmount_flags_get_type :: IO GType instance BoxedEnum MountUnmountFlags where boxedEnumType _ = c_g_mount_unmount_flags_get_type instance IsGFlag MountUnmountFlags -- object NativeVolumeMonitor newtype NativeVolumeMonitor = NativeVolumeMonitor (ForeignPtr NativeVolumeMonitor) noNativeVolumeMonitor :: Maybe NativeVolumeMonitor noNativeVolumeMonitor = Nothing foreign import ccall "g_native_volume_monitor_get_type" c_g_native_volume_monitor_get_type :: IO GType type instance ParentTypes NativeVolumeMonitor = '[VolumeMonitor, GObject.Object] instance GObject NativeVolumeMonitor where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_native_volume_monitor_get_type class GObject o => NativeVolumeMonitorK o instance (GObject o, IsDescendantOf NativeVolumeMonitor o) => NativeVolumeMonitorK o toNativeVolumeMonitor :: NativeVolumeMonitorK o => o -> IO NativeVolumeMonitor toNativeVolumeMonitor = unsafeCastTo NativeVolumeMonitor -- object NetworkAddress newtype NetworkAddress = NetworkAddress (ForeignPtr NetworkAddress) noNetworkAddress :: Maybe NetworkAddress noNetworkAddress = Nothing foreign import ccall "g_network_address_get_type" c_g_network_address_get_type :: IO GType type instance ParentTypes NetworkAddress = '[GObject.Object, SocketConnectable] instance GObject NetworkAddress where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_network_address_get_type class GObject o => NetworkAddressK o instance (GObject o, IsDescendantOf NetworkAddress o) => NetworkAddressK o toNetworkAddress :: NetworkAddressK o => o -> IO NetworkAddress toNetworkAddress = unsafeCastTo NetworkAddress -- method NetworkAddress::new -- method type : Constructor -- Args : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt16, 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},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "NetworkAddress" -- throws : False -- Skip return : False foreign import ccall "g_network_address_new" g_network_address_new :: CString -> -- hostname : TBasicType TUTF8 Word16 -> -- port : TBasicType TUInt16 IO (Ptr NetworkAddress) networkAddressNew :: (MonadIO m) => T.Text -> -- hostname Word16 -> -- port m NetworkAddress networkAddressNew hostname port = liftIO $ do hostname' <- textToCString hostname result <- g_network_address_new hostname' port checkUnexpectedReturnNULL "g_network_address_new" result result' <- (wrapObject NetworkAddress) result freeMem hostname' return result' -- method NetworkAddress::new_loopback -- method type : Constructor -- Args : [Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "NetworkAddress" -- throws : False -- Skip return : False foreign import ccall "g_network_address_new_loopback" g_network_address_new_loopback :: Word16 -> -- port : TBasicType TUInt16 IO (Ptr NetworkAddress) networkAddressNewLoopback :: (MonadIO m) => Word16 -> -- port m NetworkAddress networkAddressNewLoopback port = liftIO $ do result <- g_network_address_new_loopback port checkUnexpectedReturnNULL "g_network_address_new_loopback" result result' <- (wrapObject NetworkAddress) result return result' -- method NetworkAddress::get_hostname -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_network_address_get_hostname" g_network_address_get_hostname :: Ptr NetworkAddress -> -- _obj : TInterface "Gio" "NetworkAddress" IO CString networkAddressGetHostname :: (MonadIO m, NetworkAddressK a) => a -> -- _obj m T.Text networkAddressGetHostname _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_address_get_hostname _obj' checkUnexpectedReturnNULL "g_network_address_get_hostname" result result' <- cstringToText result touchManagedPtr _obj return result' -- method NetworkAddress::get_port -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "g_network_address_get_port" g_network_address_get_port :: Ptr NetworkAddress -> -- _obj : TInterface "Gio" "NetworkAddress" IO Word16 networkAddressGetPort :: (MonadIO m, NetworkAddressK a) => a -> -- _obj m Word16 networkAddressGetPort _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_address_get_port _obj' touchManagedPtr _obj return result -- method NetworkAddress::get_scheme -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_network_address_get_scheme" g_network_address_get_scheme :: Ptr NetworkAddress -> -- _obj : TInterface "Gio" "NetworkAddress" IO CString networkAddressGetScheme :: (MonadIO m, NetworkAddressK a) => a -> -- _obj m T.Text networkAddressGetScheme _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_address_get_scheme _obj' checkUnexpectedReturnNULL "g_network_address_get_scheme" result result' <- cstringToText result touchManagedPtr _obj return result' -- method NetworkAddress::parse -- method type : MemberFunction -- Args : [Arg {argName = "host_and_port", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "host_and_port", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnectable" -- throws : True -- Skip return : False foreign import ccall "g_network_address_parse" g_network_address_parse :: CString -> -- host_and_port : TBasicType TUTF8 Word16 -> -- default_port : TBasicType TUInt16 Ptr (Ptr GError) -> -- error IO (Ptr SocketConnectable) networkAddressParse :: (MonadIO m) => T.Text -> -- host_and_port Word16 -> -- default_port m SocketConnectable networkAddressParse host_and_port default_port = liftIO $ do host_and_port' <- textToCString host_and_port onException (do result <- propagateGError $ g_network_address_parse host_and_port' default_port checkUnexpectedReturnNULL "g_network_address_parse" result result' <- (wrapObject SocketConnectable) result freeMem host_and_port' return result' ) (do freeMem host_and_port' ) -- method NetworkAddress::parse_uri -- method type : MemberFunction -- Args : [Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_port", argType = TBasicType TUInt16, 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},Arg {argName = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnectable" -- throws : True -- Skip return : False foreign import ccall "g_network_address_parse_uri" g_network_address_parse_uri :: CString -> -- uri : TBasicType TUTF8 Word16 -> -- default_port : TBasicType TUInt16 Ptr (Ptr GError) -> -- error IO (Ptr SocketConnectable) networkAddressParseUri :: (MonadIO m) => T.Text -> -- uri Word16 -> -- default_port m SocketConnectable networkAddressParseUri uri default_port = liftIO $ do uri' <- textToCString uri onException (do result <- propagateGError $ g_network_address_parse_uri uri' default_port checkUnexpectedReturnNULL "g_network_address_parse_uri" result result' <- (wrapObject SocketConnectable) result freeMem uri' return result' ) (do freeMem uri' ) -- Enum NetworkConnectivity data NetworkConnectivity = NetworkConnectivityLocal | NetworkConnectivityLimited | NetworkConnectivityPortal | NetworkConnectivityFull | AnotherNetworkConnectivity Int deriving (Show, Eq) instance Enum NetworkConnectivity where fromEnum NetworkConnectivityLocal = 1 fromEnum NetworkConnectivityLimited = 2 fromEnum NetworkConnectivityPortal = 3 fromEnum NetworkConnectivityFull = 4 fromEnum (AnotherNetworkConnectivity k) = k toEnum 1 = NetworkConnectivityLocal toEnum 2 = NetworkConnectivityLimited toEnum 3 = NetworkConnectivityPortal toEnum 4 = NetworkConnectivityFull toEnum k = AnotherNetworkConnectivity k foreign import ccall "g_network_connectivity_get_type" c_g_network_connectivity_get_type :: IO GType instance BoxedEnum NetworkConnectivity where boxedEnumType _ = c_g_network_connectivity_get_type -- interface NetworkMonitor newtype NetworkMonitor = NetworkMonitor (ForeignPtr NetworkMonitor) noNetworkMonitor :: Maybe NetworkMonitor noNetworkMonitor = Nothing foreign import ccall "g_network_monitor_get_type" c_g_network_monitor_get_type :: IO GType type instance ParentTypes NetworkMonitor = '[Initable, GObject.Object] instance GObject NetworkMonitor where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_network_monitor_get_type class GObject o => NetworkMonitorK o instance (GObject o, IsDescendantOf NetworkMonitor o) => NetworkMonitorK o toNetworkMonitor :: NetworkMonitorK o => o -> IO NetworkMonitor toNetworkMonitor = unsafeCastTo NetworkMonitor -- method NetworkMonitor::can_reach -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connectable", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connectable", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_network_monitor_can_reach" g_network_monitor_can_reach :: Ptr NetworkMonitor -> -- _obj : TInterface "Gio" "NetworkMonitor" Ptr SocketConnectable -> -- connectable : TInterface "Gio" "SocketConnectable" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt networkMonitorCanReach :: (MonadIO m, NetworkMonitorK a, SocketConnectableK b, CancellableK c) => a -> -- _obj b -> -- connectable Maybe (c) -> -- cancellable m () networkMonitorCanReach _obj connectable cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connectable' = unsafeManagedPtrCastPtr connectable maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_network_monitor_can_reach _obj' connectable' maybeCancellable touchManagedPtr _obj touchManagedPtr connectable whenJust cancellable touchManagedPtr return () ) (do return () ) -- method NetworkMonitor::can_reach_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connectable", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connectable", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_network_monitor_can_reach_async" g_network_monitor_can_reach_async :: Ptr NetworkMonitor -> -- _obj : TInterface "Gio" "NetworkMonitor" Ptr SocketConnectable -> -- connectable : TInterface "Gio" "SocketConnectable" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () networkMonitorCanReachAsync :: (MonadIO m, NetworkMonitorK a, SocketConnectableK b, CancellableK c) => a -> -- _obj b -> -- connectable Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () networkMonitorCanReachAsync _obj connectable cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connectable' = unsafeManagedPtrCastPtr connectable maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_network_monitor_can_reach_async _obj' connectable' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr connectable whenJust cancellable touchManagedPtr return () -- method NetworkMonitor::can_reach_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_network_monitor_can_reach_finish" g_network_monitor_can_reach_finish :: Ptr NetworkMonitor -> -- _obj : TInterface "Gio" "NetworkMonitor" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt networkMonitorCanReachFinish :: (MonadIO m, NetworkMonitorK a, AsyncResultK b) => a -> -- _obj b -> -- result m () networkMonitorCanReachFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_network_monitor_can_reach_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method NetworkMonitor::get_connectivity -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "NetworkConnectivity" -- throws : False -- Skip return : False foreign import ccall "g_network_monitor_get_connectivity" g_network_monitor_get_connectivity :: Ptr NetworkMonitor -> -- _obj : TInterface "Gio" "NetworkMonitor" IO CUInt networkMonitorGetConnectivity :: (MonadIO m, NetworkMonitorK a) => a -> -- _obj m NetworkConnectivity networkMonitorGetConnectivity _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_monitor_get_connectivity _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method NetworkMonitor::get_network_available -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_network_monitor_get_network_available" g_network_monitor_get_network_available :: Ptr NetworkMonitor -> -- _obj : TInterface "Gio" "NetworkMonitor" IO CInt networkMonitorGetNetworkAvailable :: (MonadIO m, NetworkMonitorK a) => a -> -- _obj m Bool networkMonitorGetNetworkAvailable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_monitor_get_network_available _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- signal NetworkMonitor::network-changed type NetworkMonitorNetworkChangedCallback = Bool -> IO () noNetworkMonitorNetworkChangedCallback :: Maybe NetworkMonitorNetworkChangedCallback noNetworkMonitorNetworkChangedCallback = Nothing type NetworkMonitorNetworkChangedCallbackC = Ptr () -> -- object CInt -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkNetworkMonitorNetworkChangedCallback :: NetworkMonitorNetworkChangedCallbackC -> IO (FunPtr NetworkMonitorNetworkChangedCallbackC) networkMonitorNetworkChangedClosure :: NetworkMonitorNetworkChangedCallback -> IO Closure networkMonitorNetworkChangedClosure cb = newCClosure =<< mkNetworkMonitorNetworkChangedCallback wrapped where wrapped = networkMonitorNetworkChangedCallbackWrapper cb networkMonitorNetworkChangedCallbackWrapper :: NetworkMonitorNetworkChangedCallback -> Ptr () -> CInt -> Ptr () -> IO () networkMonitorNetworkChangedCallbackWrapper _cb _ available _ = do let available' = (/= 0) available _cb available' onNetworkMonitorNetworkChanged :: (GObject a, MonadIO m) => a -> NetworkMonitorNetworkChangedCallback -> m SignalHandlerId onNetworkMonitorNetworkChanged obj cb = liftIO $ connectNetworkMonitorNetworkChanged obj cb SignalConnectBefore afterNetworkMonitorNetworkChanged :: (GObject a, MonadIO m) => a -> NetworkMonitorNetworkChangedCallback -> m SignalHandlerId afterNetworkMonitorNetworkChanged obj cb = connectNetworkMonitorNetworkChanged obj cb SignalConnectAfter connectNetworkMonitorNetworkChanged :: (GObject a, MonadIO m) => a -> NetworkMonitorNetworkChangedCallback -> SignalConnectMode -> m SignalHandlerId connectNetworkMonitorNetworkChanged obj cb after = liftIO $ do cb' <- mkNetworkMonitorNetworkChangedCallback (networkMonitorNetworkChangedCallbackWrapper cb) connectSignalFunPtr obj "network-changed" cb' after -- object NetworkService newtype NetworkService = NetworkService (ForeignPtr NetworkService) noNetworkService :: Maybe NetworkService noNetworkService = Nothing foreign import ccall "g_network_service_get_type" c_g_network_service_get_type :: IO GType type instance ParentTypes NetworkService = '[GObject.Object, SocketConnectable] instance GObject NetworkService where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_network_service_get_type class GObject o => NetworkServiceK o instance (GObject o, IsDescendantOf NetworkService o) => NetworkServiceK o toNetworkService :: NetworkServiceK o => o -> IO NetworkService toNetworkService = unsafeCastTo NetworkService -- method NetworkService::new -- method type : Constructor -- Args : [Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, 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 = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, 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 : TInterface "Gio" "NetworkService" -- throws : False -- Skip return : False foreign import ccall "g_network_service_new" g_network_service_new :: CString -> -- service : TBasicType TUTF8 CString -> -- protocol : TBasicType TUTF8 CString -> -- domain : TBasicType TUTF8 IO (Ptr NetworkService) networkServiceNew :: (MonadIO m) => T.Text -> -- service T.Text -> -- protocol T.Text -> -- domain m NetworkService networkServiceNew service protocol domain = liftIO $ do service' <- textToCString service protocol' <- textToCString protocol domain' <- textToCString domain result <- g_network_service_new service' protocol' domain' checkUnexpectedReturnNULL "g_network_service_new" result result' <- (wrapObject NetworkService) result freeMem service' freeMem protocol' freeMem domain' return result' -- method NetworkService::get_domain -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_network_service_get_domain" g_network_service_get_domain :: Ptr NetworkService -> -- _obj : TInterface "Gio" "NetworkService" IO CString networkServiceGetDomain :: (MonadIO m, NetworkServiceK a) => a -> -- _obj m T.Text networkServiceGetDomain _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_service_get_domain _obj' checkUnexpectedReturnNULL "g_network_service_get_domain" result result' <- cstringToText result touchManagedPtr _obj return result' -- method NetworkService::get_protocol -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_network_service_get_protocol" g_network_service_get_protocol :: Ptr NetworkService -> -- _obj : TInterface "Gio" "NetworkService" IO CString networkServiceGetProtocol :: (MonadIO m, NetworkServiceK a) => a -> -- _obj m T.Text networkServiceGetProtocol _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_service_get_protocol _obj' checkUnexpectedReturnNULL "g_network_service_get_protocol" result result' <- cstringToText result touchManagedPtr _obj return result' -- method NetworkService::get_scheme -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_network_service_get_scheme" g_network_service_get_scheme :: Ptr NetworkService -> -- _obj : TInterface "Gio" "NetworkService" IO CString networkServiceGetScheme :: (MonadIO m, NetworkServiceK a) => a -> -- _obj m T.Text networkServiceGetScheme _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_service_get_scheme _obj' checkUnexpectedReturnNULL "g_network_service_get_scheme" result result' <- cstringToText result touchManagedPtr _obj return result' -- method NetworkService::get_service -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_network_service_get_service" g_network_service_get_service :: Ptr NetworkService -> -- _obj : TInterface "Gio" "NetworkService" IO CString networkServiceGetService :: (MonadIO m, NetworkServiceK a) => a -> -- _obj m T.Text networkServiceGetService _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_network_service_get_service _obj' checkUnexpectedReturnNULL "g_network_service_get_service" result result' <- cstringToText result touchManagedPtr _obj return result' -- method NetworkService::set_scheme -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "NetworkService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scheme", 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_network_service_set_scheme" g_network_service_set_scheme :: Ptr NetworkService -> -- _obj : TInterface "Gio" "NetworkService" CString -> -- scheme : TBasicType TUTF8 IO () networkServiceSetScheme :: (MonadIO m, NetworkServiceK a) => a -> -- _obj T.Text -> -- scheme m () networkServiceSetScheme _obj scheme = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj scheme' <- textToCString scheme g_network_service_set_scheme _obj' scheme' touchManagedPtr _obj freeMem scheme' return () -- object Notification newtype Notification = Notification (ForeignPtr Notification) noNotification :: Maybe Notification noNotification = Nothing foreign import ccall "g_notification_get_type" c_g_notification_get_type :: IO GType type instance ParentTypes Notification = '[GObject.Object] instance GObject Notification where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_notification_get_type class GObject o => NotificationK o instance (GObject o, IsDescendantOf Notification o) => NotificationK o toNotification :: NotificationK o => o -> IO Notification toNotification = unsafeCastTo Notification -- method Notification::new -- method type : Constructor -- Args : [Arg {argName = "title", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "title", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Notification" -- throws : False -- Skip return : False foreign import ccall "g_notification_new" g_notification_new :: CString -> -- title : TBasicType TUTF8 IO (Ptr Notification) notificationNew :: (MonadIO m) => T.Text -> -- title m Notification notificationNew title = liftIO $ do title' <- textToCString title result <- g_notification_new title' checkUnexpectedReturnNULL "g_notification_new" result result' <- (wrapObject Notification) result freeMem title' return result' -- method Notification::add_button -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", 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_notification_add_button" g_notification_add_button :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" CString -> -- label : TBasicType TUTF8 CString -> -- detailed_action : TBasicType TUTF8 IO () notificationAddButton :: (MonadIO m, NotificationK a) => a -> -- _obj T.Text -> -- label T.Text -> -- detailed_action m () notificationAddButton _obj label detailed_action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj label' <- textToCString label detailed_action' <- textToCString detailed_action g_notification_add_button _obj' label' detailed_action' touchManagedPtr _obj freeMem label' freeMem detailed_action' return () -- method Notification::add_button_with_target -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "label", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_notification_add_button_with_target_value" g_notification_add_button_with_target_value :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" CString -> -- label : TBasicType TUTF8 CString -> -- action : TBasicType TUTF8 Ptr GVariant -> -- target : TVariant IO () notificationAddButtonWithTarget :: (MonadIO m, NotificationK a) => a -> -- _obj T.Text -> -- label T.Text -> -- action Maybe (GVariant) -> -- target m () notificationAddButtonWithTarget _obj label action target = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj label' <- textToCString label action' <- textToCString action maybeTarget <- case target of Nothing -> return nullPtr Just jTarget -> do let jTarget' = unsafeManagedPtrGetPtr jTarget return jTarget' g_notification_add_button_with_target_value _obj' label' action' maybeTarget touchManagedPtr _obj freeMem label' freeMem action' return () -- method Notification::set_body -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "body", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "body", 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_notification_set_body" g_notification_set_body :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" CString -> -- body : TBasicType TUTF8 IO () notificationSetBody :: (MonadIO m, NotificationK a) => a -> -- _obj Maybe (T.Text) -> -- body m () notificationSetBody _obj body = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeBody <- case body of Nothing -> return nullPtr Just jBody -> do jBody' <- textToCString jBody return jBody' g_notification_set_body _obj' maybeBody touchManagedPtr _obj freeMem maybeBody return () -- method Notification::set_default_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_action", 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_notification_set_default_action" g_notification_set_default_action :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" CString -> -- detailed_action : TBasicType TUTF8 IO () notificationSetDefaultAction :: (MonadIO m, NotificationK a) => a -> -- _obj T.Text -> -- detailed_action m () notificationSetDefaultAction _obj detailed_action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj detailed_action' <- textToCString detailed_action g_notification_set_default_action _obj' detailed_action' touchManagedPtr _obj freeMem detailed_action' return () -- method Notification::set_default_action_and_target -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_notification_set_default_action_and_target_value" g_notification_set_default_action_and_target_value :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" CString -> -- action : TBasicType TUTF8 Ptr GVariant -> -- target : TVariant IO () notificationSetDefaultActionAndTarget :: (MonadIO m, NotificationK a) => a -> -- _obj T.Text -> -- action Maybe (GVariant) -> -- target m () notificationSetDefaultActionAndTarget _obj action target = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action' <- textToCString action maybeTarget <- case target of Nothing -> return nullPtr Just jTarget -> do let jTarget' = unsafeManagedPtrGetPtr jTarget return jTarget' g_notification_set_default_action_and_target_value _obj' action' maybeTarget touchManagedPtr _obj freeMem action' return () -- method Notification::set_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icon", argType = TInterface "Gio" "Icon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_notification_set_icon" g_notification_set_icon :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" Ptr Icon -> -- icon : TInterface "Gio" "Icon" IO () notificationSetIcon :: (MonadIO m, NotificationK a, IconK b) => a -> -- _obj b -> -- icon m () notificationSetIcon _obj icon = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let icon' = unsafeManagedPtrCastPtr icon g_notification_set_icon _obj' icon' touchManagedPtr _obj touchManagedPtr icon return () -- method Notification::set_priority -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TInterface "Gio" "NotificationPriority", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TInterface "Gio" "NotificationPriority", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_notification_set_priority" g_notification_set_priority :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" CUInt -> -- priority : TInterface "Gio" "NotificationPriority" IO () notificationSetPriority :: (MonadIO m, NotificationK a) => a -> -- _obj NotificationPriority -> -- priority m () notificationSetPriority _obj priority = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let priority' = (fromIntegral . fromEnum) priority g_notification_set_priority _obj' priority' touchManagedPtr _obj return () -- method Notification::set_title -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, 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 "Gio" "Notification", direction = DirectionIn, mayBeNull = False, 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_notification_set_title" g_notification_set_title :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" CString -> -- title : TBasicType TUTF8 IO () notificationSetTitle :: (MonadIO m, NotificationK a) => a -> -- _obj T.Text -> -- title m () notificationSetTitle _obj title = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj title' <- textToCString title g_notification_set_title _obj' title' touchManagedPtr _obj freeMem title' return () -- method Notification::set_urgent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "urgent", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "urgent", 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_notification_set_urgent" g_notification_set_urgent :: Ptr Notification -> -- _obj : TInterface "Gio" "Notification" CInt -> -- urgent : TBasicType TBoolean IO () notificationSetUrgent :: (MonadIO m, NotificationK a) => a -> -- _obj Bool -> -- urgent m () notificationSetUrgent _obj urgent = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let urgent' = (fromIntegral . fromEnum) urgent g_notification_set_urgent _obj' urgent' touchManagedPtr _obj return () -- Enum NotificationPriority data NotificationPriority = NotificationPriorityNormal | NotificationPriorityLow | NotificationPriorityHigh | NotificationPriorityUrgent | AnotherNotificationPriority Int deriving (Show, Eq) instance Enum NotificationPriority where fromEnum NotificationPriorityNormal = 0 fromEnum NotificationPriorityLow = 1 fromEnum NotificationPriorityHigh = 2 fromEnum NotificationPriorityUrgent = 3 fromEnum (AnotherNotificationPriority k) = k toEnum 0 = NotificationPriorityNormal toEnum 1 = NotificationPriorityLow toEnum 2 = NotificationPriorityHigh toEnum 3 = NotificationPriorityUrgent toEnum k = AnotherNotificationPriority k foreign import ccall "g_notification_priority_get_type" c_g_notification_priority_get_type :: IO GType instance BoxedEnum NotificationPriority where boxedEnumType _ = c_g_notification_priority_get_type -- struct OutputMessage newtype OutputMessage = OutputMessage (ForeignPtr OutputMessage) noOutputMessage :: Maybe OutputMessage noOutputMessage = Nothing outputMessageReadAddress :: OutputMessage -> IO SocketAddress outputMessageReadAddress s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr SocketAddress) val' <- (newObject SocketAddress) val return val' outputMessageReadVectors :: OutputMessage -> IO OutputVector outputMessageReadVectors s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr OutputVector) val' <- (newPtr 16 OutputVector) val return val' outputMessageReadNumVectors :: OutputMessage -> IO Word32 outputMessageReadNumVectors s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word32 return val outputMessageReadBytesSent :: OutputMessage -> IO Word32 outputMessageReadBytesSent s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Word32 return val -- XXX Skipped getter for "OutputMessage:control_messages" :: Not implemented: "Don't know how to unpack C array of type TCArray False (-1) 5 (TInterface \"Gio\" \"SocketControlMessage\")" outputMessageReadNumControlMessages :: OutputMessage -> IO Word32 outputMessageReadNumControlMessages s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO Word32 return val -- object OutputStream newtype OutputStream = OutputStream (ForeignPtr OutputStream) noOutputStream :: Maybe OutputStream noOutputStream = Nothing foreign import ccall "g_output_stream_get_type" c_g_output_stream_get_type :: IO GType type instance ParentTypes OutputStream = '[GObject.Object] instance GObject OutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_output_stream_get_type class GObject o => OutputStreamK o instance (GObject o, IsDescendantOf OutputStream o) => OutputStreamK o toOutputStream :: OutputStreamK o => o -> IO OutputStream toOutputStream = unsafeCastTo OutputStream -- method OutputStream::clear_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_output_stream_clear_pending" g_output_stream_clear_pending :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" IO () outputStreamClearPending :: (MonadIO m, OutputStreamK a) => a -> -- _obj m () outputStreamClearPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_output_stream_clear_pending _obj' touchManagedPtr _obj return () -- method OutputStream::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_output_stream_close" g_output_stream_close :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt outputStreamClose :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () outputStreamClose _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_output_stream_close _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method OutputStream::close_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_output_stream_close_async" g_output_stream_close_async :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () outputStreamCloseAsync :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () outputStreamCloseAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_output_stream_close_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method OutputStream::close_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_output_stream_close_finish" g_output_stream_close_finish :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt outputStreamCloseFinish :: (MonadIO m, OutputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m () outputStreamCloseFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_output_stream_close_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method OutputStream::flush -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_output_stream_flush" g_output_stream_flush :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt outputStreamFlush :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () outputStreamFlush _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_output_stream_flush _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method OutputStream::flush_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_output_stream_flush_async" g_output_stream_flush_async :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () outputStreamFlushAsync :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () outputStreamFlushAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_output_stream_flush_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method OutputStream::flush_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_output_stream_flush_finish" g_output_stream_flush_finish :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt outputStreamFlushFinish :: (MonadIO m, OutputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m () outputStreamFlushFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_output_stream_flush_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method OutputStream::has_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_output_stream_has_pending" g_output_stream_has_pending :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" IO CInt outputStreamHasPending :: (MonadIO m, OutputStreamK a) => a -> -- _obj m Bool outputStreamHasPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_output_stream_has_pending _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method OutputStream::is_closed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_output_stream_is_closed" g_output_stream_is_closed :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" IO CInt outputStreamIsClosed :: (MonadIO m, OutputStreamK a) => a -> -- _obj m Bool outputStreamIsClosed _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_output_stream_is_closed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method OutputStream::is_closing -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_output_stream_is_closing" g_output_stream_is_closing :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" IO CInt outputStreamIsClosing :: (MonadIO m, OutputStreamK a) => a -> -- _obj m Bool outputStreamIsClosing _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_output_stream_is_closing _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method OutputStream::set_pending -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_output_stream_set_pending" g_output_stream_set_pending :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr (Ptr GError) -> -- error IO CInt outputStreamSetPending :: (MonadIO m, OutputStreamK a) => a -> -- _obj m () outputStreamSetPending _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_output_stream_set_pending _obj' touchManagedPtr _obj return () ) (do return () ) -- method OutputStream::splice -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "OutputStreamSpliceFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "OutputStreamSpliceFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_output_stream_splice" g_output_stream_splice :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr InputStream -> -- source : TInterface "Gio" "InputStream" CUInt -> -- flags : TInterface "Gio" "OutputStreamSpliceFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 outputStreamSplice :: (MonadIO m, OutputStreamK a, InputStreamK b, CancellableK c) => a -> -- _obj b -> -- source [OutputStreamSpliceFlags] -> -- flags Maybe (c) -> -- cancellable m Int64 outputStreamSplice _obj source flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let source' = unsafeManagedPtrCastPtr source let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_output_stream_splice _obj' source' flags' maybeCancellable touchManagedPtr _obj touchManagedPtr source whenJust cancellable touchManagedPtr return result ) (do return () ) -- method OutputStream::splice_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "OutputStreamSpliceFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "OutputStreamSpliceFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_output_stream_splice_async" g_output_stream_splice_async :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr InputStream -> -- source : TInterface "Gio" "InputStream" CUInt -> -- flags : TInterface "Gio" "OutputStreamSpliceFlags" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () outputStreamSpliceAsync :: (MonadIO m, OutputStreamK a, InputStreamK b, CancellableK c) => a -> -- _obj b -> -- source [OutputStreamSpliceFlags] -> -- flags Int32 -> -- io_priority Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () outputStreamSpliceAsync _obj source flags io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let source' = unsafeManagedPtrCastPtr source let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_output_stream_splice_async _obj' source' flags' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr source whenJust cancellable touchManagedPtr return () -- method OutputStream::splice_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_output_stream_splice_finish" g_output_stream_splice_finish :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO Int64 outputStreamSpliceFinish :: (MonadIO m, OutputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m Int64 outputStreamSpliceFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_output_stream_splice_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return result ) (do return () ) -- method OutputStream::write -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_output_stream_write" g_output_stream_write :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 outputStreamWrite :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m Int64 outputStreamWrite _obj buffer cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_output_stream_write _obj' buffer' count maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- method OutputStream::write_all -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_output_stream_write_all" g_output_stream_write_all :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Ptr Word64 -> -- bytes_written : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt outputStreamWriteAll :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m (Word64) outputStreamWriteAll _obj buffer cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer bytes_written <- allocMem :: IO (Ptr Word64) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_output_stream_write_all _obj' buffer' count bytes_written maybeCancellable bytes_written' <- peek bytes_written touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' freeMem bytes_written return bytes_written' ) (do freeMem buffer' freeMem bytes_written ) -- method OutputStream::write_all_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_output_stream_write_all_async" g_output_stream_write_all_async :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () outputStreamWriteAllAsync :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () outputStreamWriteAllAsync _obj buffer io_priority cancellable callback = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_output_stream_write_all_async _obj' buffer' count io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return () -- method OutputStream::write_all_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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 "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_output_stream_write_all_finish" g_output_stream_write_all_finish :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr Word64 -> -- bytes_written : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CInt outputStreamWriteAllFinish :: (MonadIO m, OutputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m (Word64) outputStreamWriteAllFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ bytes_written <- allocMem :: IO (Ptr Word64) onException (do _ <- propagateGError $ g_output_stream_write_all_finish _obj' result_' bytes_written bytes_written' <- peek bytes_written touchManagedPtr _obj touchManagedPtr result_ freeMem bytes_written return bytes_written' ) (do freeMem bytes_written ) -- method OutputStream::write_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_output_stream_write_async" g_output_stream_write_async :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () outputStreamWriteAsync :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () outputStreamWriteAsync _obj buffer io_priority cancellable callback = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_output_stream_write_async _obj' buffer' count io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return () -- method OutputStream::write_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_output_stream_write_bytes" g_output_stream_write_bytes :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr GLib.Bytes -> -- bytes : TInterface "GLib" "Bytes" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 outputStreamWriteBytes :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj GLib.Bytes -> -- bytes Maybe (b) -> -- cancellable m Int64 outputStreamWriteBytes _obj bytes cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let bytes' = unsafeManagedPtrGetPtr bytes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_output_stream_write_bytes _obj' bytes' maybeCancellable touchManagedPtr _obj touchManagedPtr bytes whenJust cancellable touchManagedPtr return result ) (do return () ) -- method OutputStream::write_bytes_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_output_stream_write_bytes_async" g_output_stream_write_bytes_async :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr GLib.Bytes -> -- bytes : TInterface "GLib" "Bytes" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () outputStreamWriteBytesAsync :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- _obj GLib.Bytes -> -- bytes Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () outputStreamWriteBytesAsync _obj bytes io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let bytes' = unsafeManagedPtrGetPtr bytes maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_output_stream_write_bytes_async _obj' bytes' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr bytes whenJust cancellable touchManagedPtr return () -- method OutputStream::write_bytes_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_output_stream_write_bytes_finish" g_output_stream_write_bytes_finish :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO Int64 outputStreamWriteBytesFinish :: (MonadIO m, OutputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m Int64 outputStreamWriteBytesFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_output_stream_write_bytes_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return result ) (do return () ) -- method OutputStream::write_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_output_stream_write_finish" g_output_stream_write_finish :: Ptr OutputStream -> -- _obj : TInterface "Gio" "OutputStream" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO Int64 outputStreamWriteFinish :: (MonadIO m, OutputStreamK a, AsyncResultK b) => a -> -- _obj b -> -- result m Int64 outputStreamWriteFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_output_stream_write_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return result ) (do return () ) -- Flags OutputStreamSpliceFlags data OutputStreamSpliceFlags = OutputStreamSpliceFlagsNone | OutputStreamSpliceFlagsCloseSource | OutputStreamSpliceFlagsCloseTarget | AnotherOutputStreamSpliceFlags Int deriving (Show, Eq) instance Enum OutputStreamSpliceFlags where fromEnum OutputStreamSpliceFlagsNone = 0 fromEnum OutputStreamSpliceFlagsCloseSource = 1 fromEnum OutputStreamSpliceFlagsCloseTarget = 2 fromEnum (AnotherOutputStreamSpliceFlags k) = k toEnum 0 = OutputStreamSpliceFlagsNone toEnum 1 = OutputStreamSpliceFlagsCloseSource toEnum 2 = OutputStreamSpliceFlagsCloseTarget toEnum k = AnotherOutputStreamSpliceFlags k foreign import ccall "g_output_stream_splice_flags_get_type" c_g_output_stream_splice_flags_get_type :: IO GType instance BoxedEnum OutputStreamSpliceFlags where boxedEnumType _ = c_g_output_stream_splice_flags_get_type instance IsGFlag OutputStreamSpliceFlags -- struct OutputVector newtype OutputVector = OutputVector (ForeignPtr OutputVector) noOutputVector :: Maybe OutputVector noOutputVector = Nothing outputVectorReadBuffer :: OutputVector -> IO (Ptr ()) outputVectorReadBuffer s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val outputVectorReadSize :: OutputVector -> IO Word64 outputVectorReadSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word64 return val -- Enum PasswordSave data PasswordSave = PasswordSaveNever | PasswordSaveForSession | PasswordSavePermanently | AnotherPasswordSave Int deriving (Show, Eq) instance Enum PasswordSave where fromEnum PasswordSaveNever = 0 fromEnum PasswordSaveForSession = 1 fromEnum PasswordSavePermanently = 2 fromEnum (AnotherPasswordSave k) = k toEnum 0 = PasswordSaveNever toEnum 1 = PasswordSaveForSession toEnum 2 = PasswordSavePermanently toEnum k = AnotherPasswordSave k foreign import ccall "g_password_save_get_type" c_g_password_save_get_type :: IO GType instance BoxedEnum PasswordSave where boxedEnumType _ = c_g_password_save_get_type -- object Permission newtype Permission = Permission (ForeignPtr Permission) noPermission :: Maybe Permission noPermission = Nothing foreign import ccall "g_permission_get_type" c_g_permission_get_type :: IO GType type instance ParentTypes Permission = '[GObject.Object] instance GObject Permission where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_permission_get_type class GObject o => PermissionK o instance (GObject o, IsDescendantOf Permission o) => PermissionK o toPermission :: PermissionK o => o -> IO Permission toPermission = unsafeCastTo Permission -- method Permission::acquire -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_permission_acquire" g_permission_acquire :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt permissionAcquire :: (MonadIO m, PermissionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () permissionAcquire _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_permission_acquire _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Permission::acquire_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_permission_acquire_async" g_permission_acquire_async :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () permissionAcquireAsync :: (MonadIO m, PermissionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () permissionAcquireAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_permission_acquire_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Permission::acquire_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_permission_acquire_finish" g_permission_acquire_finish :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt permissionAcquireFinish :: (MonadIO m, PermissionK a, AsyncResultK b) => a -> -- _obj b -> -- result m () permissionAcquireFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_permission_acquire_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Permission::get_allowed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_permission_get_allowed" g_permission_get_allowed :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" IO CInt permissionGetAllowed :: (MonadIO m, PermissionK a) => a -> -- _obj m Bool permissionGetAllowed _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_permission_get_allowed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Permission::get_can_acquire -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_permission_get_can_acquire" g_permission_get_can_acquire :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" IO CInt permissionGetCanAcquire :: (MonadIO m, PermissionK a) => a -> -- _obj m Bool permissionGetCanAcquire _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_permission_get_can_acquire _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Permission::get_can_release -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_permission_get_can_release" g_permission_get_can_release :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" IO CInt permissionGetCanRelease :: (MonadIO m, PermissionK a) => a -> -- _obj m Bool permissionGetCanRelease _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_permission_get_can_release _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Permission::impl_update -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allowed", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "can_acquire", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "can_release", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allowed", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "can_acquire", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "can_release", 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_permission_impl_update" g_permission_impl_update :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" CInt -> -- allowed : TBasicType TBoolean CInt -> -- can_acquire : TBasicType TBoolean CInt -> -- can_release : TBasicType TBoolean IO () permissionImplUpdate :: (MonadIO m, PermissionK a) => a -> -- _obj Bool -> -- allowed Bool -> -- can_acquire Bool -> -- can_release m () permissionImplUpdate _obj allowed can_acquire can_release = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let allowed' = (fromIntegral . fromEnum) allowed let can_acquire' = (fromIntegral . fromEnum) can_acquire let can_release' = (fromIntegral . fromEnum) can_release g_permission_impl_update _obj' allowed' can_acquire' can_release' touchManagedPtr _obj return () -- method Permission::release -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_permission_release" g_permission_release :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt permissionRelease :: (MonadIO m, PermissionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () permissionRelease _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_permission_release _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Permission::release_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_permission_release_async" g_permission_release_async :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () permissionReleaseAsync :: (MonadIO m, PermissionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () permissionReleaseAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_permission_release_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Permission::release_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Permission", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_permission_release_finish" g_permission_release_finish :: Ptr Permission -> -- _obj : TInterface "Gio" "Permission" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt permissionReleaseFinish :: (MonadIO m, PermissionK a, AsyncResultK b) => a -> -- _obj b -> -- result m () permissionReleaseFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_permission_release_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- interface PollableInputStream newtype PollableInputStream = PollableInputStream (ForeignPtr PollableInputStream) noPollableInputStream :: Maybe PollableInputStream noPollableInputStream = Nothing foreign import ccall "g_pollable_input_stream_get_type" c_g_pollable_input_stream_get_type :: IO GType type instance ParentTypes PollableInputStream = '[InputStream, GObject.Object] instance GObject PollableInputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_pollable_input_stream_get_type class GObject o => PollableInputStreamK o instance (GObject o, IsDescendantOf PollableInputStream o) => PollableInputStreamK o toPollableInputStream :: PollableInputStreamK o => o -> IO PollableInputStream toPollableInputStream = unsafeCastTo PollableInputStream -- method PollableInputStream::can_poll -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pollable_input_stream_can_poll" g_pollable_input_stream_can_poll :: Ptr PollableInputStream -> -- _obj : TInterface "Gio" "PollableInputStream" IO CInt pollableInputStreamCanPoll :: (MonadIO m, PollableInputStreamK a) => a -> -- _obj m Bool pollableInputStreamCanPoll _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_pollable_input_stream_can_poll _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method PollableInputStream::create_source -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_pollable_input_stream_create_source" g_pollable_input_stream_create_source :: Ptr PollableInputStream -> -- _obj : TInterface "Gio" "PollableInputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" IO (Ptr GLib.Source) pollableInputStreamCreateSource :: (MonadIO m, PollableInputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m GLib.Source pollableInputStreamCreateSource _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' result <- g_pollable_input_stream_create_source _obj' maybeCancellable checkUnexpectedReturnNULL "g_pollable_input_stream_create_source" result result' <- (wrapBoxed GLib.Source) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' -- method PollableInputStream::is_readable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pollable_input_stream_is_readable" g_pollable_input_stream_is_readable :: Ptr PollableInputStream -> -- _obj : TInterface "Gio" "PollableInputStream" IO CInt pollableInputStreamIsReadable :: (MonadIO m, PollableInputStreamK a) => a -> -- _obj m Bool pollableInputStreamIsReadable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_pollable_input_stream_is_readable _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method PollableInputStream::read_nonblocking -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_pollable_input_stream_read_nonblocking" g_pollable_input_stream_read_nonblocking :: Ptr PollableInputStream -> -- _obj : TInterface "Gio" "PollableInputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 pollableInputStreamReadNonblocking :: (MonadIO m, PollableInputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m Int64 pollableInputStreamReadNonblocking _obj buffer cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_pollable_input_stream_read_nonblocking _obj' buffer' count maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- interface PollableOutputStream newtype PollableOutputStream = PollableOutputStream (ForeignPtr PollableOutputStream) noPollableOutputStream :: Maybe PollableOutputStream noPollableOutputStream = Nothing foreign import ccall "g_pollable_output_stream_get_type" c_g_pollable_output_stream_get_type :: IO GType type instance ParentTypes PollableOutputStream = '[OutputStream, GObject.Object] instance GObject PollableOutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_pollable_output_stream_get_type class GObject o => PollableOutputStreamK o instance (GObject o, IsDescendantOf PollableOutputStream o) => PollableOutputStreamK o toPollableOutputStream :: PollableOutputStreamK o => o -> IO PollableOutputStream toPollableOutputStream = unsafeCastTo PollableOutputStream -- method PollableOutputStream::can_poll -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pollable_output_stream_can_poll" g_pollable_output_stream_can_poll :: Ptr PollableOutputStream -> -- _obj : TInterface "Gio" "PollableOutputStream" IO CInt pollableOutputStreamCanPoll :: (MonadIO m, PollableOutputStreamK a) => a -> -- _obj m Bool pollableOutputStreamCanPoll _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_pollable_output_stream_can_poll _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method PollableOutputStream::create_source -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_pollable_output_stream_create_source" g_pollable_output_stream_create_source :: Ptr PollableOutputStream -> -- _obj : TInterface "Gio" "PollableOutputStream" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" IO (Ptr GLib.Source) pollableOutputStreamCreateSource :: (MonadIO m, PollableOutputStreamK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m GLib.Source pollableOutputStreamCreateSource _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' result <- g_pollable_output_stream_create_source _obj' maybeCancellable checkUnexpectedReturnNULL "g_pollable_output_stream_create_source" result result' <- (wrapBoxed GLib.Source) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' -- method PollableOutputStream::is_writable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_pollable_output_stream_is_writable" g_pollable_output_stream_is_writable :: Ptr PollableOutputStream -> -- _obj : TInterface "Gio" "PollableOutputStream" IO CInt pollableOutputStreamIsWritable :: (MonadIO m, PollableOutputStreamK a) => a -> -- _obj m Bool pollableOutputStreamIsWritable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_pollable_output_stream_is_writable _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method PollableOutputStream::write_nonblocking -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "PollableOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_pollable_output_stream_write_nonblocking" g_pollable_output_stream_write_nonblocking :: Ptr PollableOutputStream -> -- _obj : TInterface "Gio" "PollableOutputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 pollableOutputStreamWriteNonblocking :: (MonadIO m, PollableOutputStreamK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m Int64 pollableOutputStreamWriteNonblocking _obj buffer cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_pollable_output_stream_write_nonblocking _obj' buffer' count maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- callback PollableSourceFunc pollableSourceFuncClosure :: PollableSourceFunc -> IO Closure pollableSourceFuncClosure cb = newCClosure =<< mkPollableSourceFunc wrapped where wrapped = pollableSourceFuncWrapper Nothing cb type PollableSourceFuncC = Ptr GObject.Object -> Ptr () -> IO CInt foreign import ccall "wrapper" mkPollableSourceFunc :: PollableSourceFuncC -> IO (FunPtr PollableSourceFuncC) type PollableSourceFunc = GObject.Object -> IO Bool noPollableSourceFunc :: Maybe PollableSourceFunc noPollableSourceFunc = Nothing pollableSourceFuncWrapper :: Maybe (Ptr (FunPtr (PollableSourceFuncC))) -> PollableSourceFunc -> Ptr GObject.Object -> Ptr () -> IO CInt pollableSourceFuncWrapper funptrptr _cb pollable_stream _ = do pollable_stream' <- (newObject GObject.Object) pollable_stream result <- _cb pollable_stream' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- object PropertyAction newtype PropertyAction = PropertyAction (ForeignPtr PropertyAction) noPropertyAction :: Maybe PropertyAction noPropertyAction = Nothing foreign import ccall "g_property_action_get_type" c_g_property_action_get_type :: IO GType type instance ParentTypes PropertyAction = '[GObject.Object, Action] instance GObject PropertyAction where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_property_action_get_type class GObject o => PropertyActionK o instance (GObject o, IsDescendantOf PropertyAction o) => PropertyActionK o toPropertyAction :: PropertyActionK o => o -> IO PropertyAction toPropertyAction = unsafeCastTo PropertyAction -- method PropertyAction::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 = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, 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 = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "PropertyAction" -- throws : False -- Skip return : False foreign import ccall "g_property_action_new" g_property_action_new :: CString -> -- name : TBasicType TUTF8 Ptr GObject.Object -> -- object : TInterface "GObject" "Object" CString -> -- property_name : TBasicType TUTF8 IO (Ptr PropertyAction) propertyActionNew :: (MonadIO m, GObject.ObjectK a) => T.Text -> -- name a -> -- object T.Text -> -- property_name m PropertyAction propertyActionNew name object property_name = liftIO $ do name' <- textToCString name let object' = unsafeManagedPtrCastPtr object property_name' <- textToCString property_name result <- g_property_action_new name' object' property_name' checkUnexpectedReturnNULL "g_property_action_new" result result' <- (wrapObject PropertyAction) result touchManagedPtr object freeMem name' freeMem property_name' return result' -- interface Proxy newtype Proxy = Proxy (ForeignPtr Proxy) noProxy :: Maybe Proxy noProxy = Nothing foreign import ccall "g_proxy_get_type" c_g_proxy_get_type :: IO GType type instance ParentTypes Proxy = '[GObject.Object] instance GObject Proxy where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_proxy_get_type class GObject o => ProxyK o instance (GObject o, IsDescendantOf Proxy o) => ProxyK o toProxy :: ProxyK o => o -> IO Proxy toProxy = unsafeCastTo Proxy -- method Proxy::connect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Proxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "proxy_address", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Proxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "proxy_address", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "IOStream" -- throws : True -- Skip return : False foreign import ccall "g_proxy_connect" g_proxy_connect :: Ptr Proxy -> -- _obj : TInterface "Gio" "Proxy" Ptr IOStream -> -- connection : TInterface "Gio" "IOStream" Ptr ProxyAddress -> -- proxy_address : TInterface "Gio" "ProxyAddress" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr IOStream) proxyConnect :: (MonadIO m, ProxyK a, IOStreamK b, ProxyAddressK c, CancellableK d) => a -> -- _obj b -> -- connection c -> -- proxy_address Maybe (d) -> -- cancellable m IOStream proxyConnect _obj connection proxy_address cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connection' = unsafeManagedPtrCastPtr connection let proxy_address' = unsafeManagedPtrCastPtr proxy_address maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_proxy_connect _obj' connection' proxy_address' maybeCancellable checkUnexpectedReturnNULL "g_proxy_connect" result result' <- (wrapObject IOStream) result touchManagedPtr _obj touchManagedPtr connection touchManagedPtr proxy_address whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method Proxy::connect_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Proxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "proxy_address", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Proxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "proxy_address", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_proxy_connect_async" g_proxy_connect_async :: Ptr Proxy -> -- _obj : TInterface "Gio" "Proxy" Ptr IOStream -> -- connection : TInterface "Gio" "IOStream" Ptr ProxyAddress -> -- proxy_address : TInterface "Gio" "ProxyAddress" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () proxyConnectAsync :: (MonadIO m, ProxyK a, IOStreamK b, ProxyAddressK c, CancellableK d) => a -> -- _obj b -> -- connection c -> -- proxy_address Maybe (d) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () proxyConnectAsync _obj connection proxy_address cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connection' = unsafeManagedPtrCastPtr connection let proxy_address' = unsafeManagedPtrCastPtr proxy_address maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_proxy_connect_async _obj' connection' proxy_address' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr connection touchManagedPtr proxy_address whenJust cancellable touchManagedPtr return () -- method Proxy::connect_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Proxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Proxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "IOStream" -- throws : True -- Skip return : False foreign import ccall "g_proxy_connect_finish" g_proxy_connect_finish :: Ptr Proxy -> -- _obj : TInterface "Gio" "Proxy" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr IOStream) proxyConnectFinish :: (MonadIO m, ProxyK a, AsyncResultK b) => a -> -- _obj b -> -- result m IOStream proxyConnectFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_proxy_connect_finish _obj' result_' checkUnexpectedReturnNULL "g_proxy_connect_finish" result result' <- (wrapObject IOStream) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method Proxy::supports_hostname -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Proxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Proxy", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_proxy_supports_hostname" g_proxy_supports_hostname :: Ptr Proxy -> -- _obj : TInterface "Gio" "Proxy" IO CInt proxySupportsHostname :: (MonadIO m, ProxyK a) => a -> -- _obj m Bool proxySupportsHostname _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_supports_hostname _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- object ProxyAddress newtype ProxyAddress = ProxyAddress (ForeignPtr ProxyAddress) noProxyAddress :: Maybe ProxyAddress noProxyAddress = Nothing foreign import ccall "g_proxy_address_get_type" c_g_proxy_address_get_type :: IO GType type instance ParentTypes ProxyAddress = '[InetSocketAddress, SocketAddress, GObject.Object, SocketConnectable] instance GObject ProxyAddress where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_proxy_address_get_type class GObject o => ProxyAddressK o instance (GObject o, IsDescendantOf ProxyAddress o) => ProxyAddressK o toProxyAddress :: ProxyAddressK o => o -> IO ProxyAddress toProxyAddress = unsafeCastTo ProxyAddress -- method ProxyAddress::new -- method type : Constructor -- Args : [Arg {argName = "inetaddr", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "username", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "inetaddr", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "username", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ProxyAddress" -- throws : False -- Skip return : False foreign import ccall "g_proxy_address_new" g_proxy_address_new :: Ptr InetAddress -> -- inetaddr : TInterface "Gio" "InetAddress" Word16 -> -- port : TBasicType TUInt16 CString -> -- protocol : TBasicType TUTF8 CString -> -- dest_hostname : TBasicType TUTF8 Word16 -> -- dest_port : TBasicType TUInt16 CString -> -- username : TBasicType TUTF8 CString -> -- password : TBasicType TUTF8 IO (Ptr ProxyAddress) proxyAddressNew :: (MonadIO m, InetAddressK a) => a -> -- inetaddr Word16 -> -- port T.Text -> -- protocol T.Text -> -- dest_hostname Word16 -> -- dest_port Maybe (T.Text) -> -- username Maybe (T.Text) -> -- password m ProxyAddress proxyAddressNew inetaddr port protocol dest_hostname dest_port username password = liftIO $ do let inetaddr' = unsafeManagedPtrCastPtr inetaddr protocol' <- textToCString protocol dest_hostname' <- textToCString dest_hostname maybeUsername <- case username of Nothing -> return nullPtr Just jUsername -> do jUsername' <- textToCString jUsername return jUsername' maybePassword <- case password of Nothing -> return nullPtr Just jPassword -> do jPassword' <- textToCString jPassword return jPassword' result <- g_proxy_address_new inetaddr' port protocol' dest_hostname' dest_port maybeUsername maybePassword checkUnexpectedReturnNULL "g_proxy_address_new" result result' <- (wrapObject ProxyAddress) result touchManagedPtr inetaddr freeMem protocol' freeMem dest_hostname' freeMem maybeUsername freeMem maybePassword return result' -- method ProxyAddress::get_destination_hostname -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_proxy_address_get_destination_hostname" g_proxy_address_get_destination_hostname :: Ptr ProxyAddress -> -- _obj : TInterface "Gio" "ProxyAddress" IO CString proxyAddressGetDestinationHostname :: (MonadIO m, ProxyAddressK a) => a -> -- _obj m T.Text proxyAddressGetDestinationHostname _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_address_get_destination_hostname _obj' checkUnexpectedReturnNULL "g_proxy_address_get_destination_hostname" result result' <- cstringToText result touchManagedPtr _obj return result' -- method ProxyAddress::get_destination_port -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "g_proxy_address_get_destination_port" g_proxy_address_get_destination_port :: Ptr ProxyAddress -> -- _obj : TInterface "Gio" "ProxyAddress" IO Word16 proxyAddressGetDestinationPort :: (MonadIO m, ProxyAddressK a) => a -> -- _obj m Word16 proxyAddressGetDestinationPort _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_address_get_destination_port _obj' touchManagedPtr _obj return result -- method ProxyAddress::get_destination_protocol -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_proxy_address_get_destination_protocol" g_proxy_address_get_destination_protocol :: Ptr ProxyAddress -> -- _obj : TInterface "Gio" "ProxyAddress" IO CString proxyAddressGetDestinationProtocol :: (MonadIO m, ProxyAddressK a) => a -> -- _obj m T.Text proxyAddressGetDestinationProtocol _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_address_get_destination_protocol _obj' checkUnexpectedReturnNULL "g_proxy_address_get_destination_protocol" result result' <- cstringToText result touchManagedPtr _obj return result' -- method ProxyAddress::get_password -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_proxy_address_get_password" g_proxy_address_get_password :: Ptr ProxyAddress -> -- _obj : TInterface "Gio" "ProxyAddress" IO CString proxyAddressGetPassword :: (MonadIO m, ProxyAddressK a) => a -> -- _obj m T.Text proxyAddressGetPassword _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_address_get_password _obj' checkUnexpectedReturnNULL "g_proxy_address_get_password" result result' <- cstringToText result touchManagedPtr _obj return result' -- method ProxyAddress::get_protocol -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_proxy_address_get_protocol" g_proxy_address_get_protocol :: Ptr ProxyAddress -> -- _obj : TInterface "Gio" "ProxyAddress" IO CString proxyAddressGetProtocol :: (MonadIO m, ProxyAddressK a) => a -> -- _obj m T.Text proxyAddressGetProtocol _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_address_get_protocol _obj' checkUnexpectedReturnNULL "g_proxy_address_get_protocol" result result' <- cstringToText result touchManagedPtr _obj return result' -- method ProxyAddress::get_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_proxy_address_get_uri" g_proxy_address_get_uri :: Ptr ProxyAddress -> -- _obj : TInterface "Gio" "ProxyAddress" IO CString proxyAddressGetUri :: (MonadIO m, ProxyAddressK a) => a -> -- _obj m T.Text proxyAddressGetUri _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_address_get_uri _obj' checkUnexpectedReturnNULL "g_proxy_address_get_uri" result result' <- cstringToText result touchManagedPtr _obj return result' -- method ProxyAddress::get_username -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_proxy_address_get_username" g_proxy_address_get_username :: Ptr ProxyAddress -> -- _obj : TInterface "Gio" "ProxyAddress" IO CString proxyAddressGetUsername :: (MonadIO m, ProxyAddressK a) => a -> -- _obj m T.Text proxyAddressGetUsername _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_address_get_username _obj' checkUnexpectedReturnNULL "g_proxy_address_get_username" result result' <- cstringToText result touchManagedPtr _obj return result' -- object ProxyAddressEnumerator newtype ProxyAddressEnumerator = ProxyAddressEnumerator (ForeignPtr ProxyAddressEnumerator) noProxyAddressEnumerator :: Maybe ProxyAddressEnumerator noProxyAddressEnumerator = Nothing foreign import ccall "g_proxy_address_enumerator_get_type" c_g_proxy_address_enumerator_get_type :: IO GType type instance ParentTypes ProxyAddressEnumerator = '[SocketAddressEnumerator, GObject.Object] instance GObject ProxyAddressEnumerator where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_proxy_address_enumerator_get_type class GObject o => ProxyAddressEnumeratorK o instance (GObject o, IsDescendantOf ProxyAddressEnumerator o) => ProxyAddressEnumeratorK o toProxyAddressEnumerator :: ProxyAddressEnumeratorK o => o -> IO ProxyAddressEnumerator toProxyAddressEnumerator = unsafeCastTo ProxyAddressEnumerator -- interface ProxyResolver newtype ProxyResolver = ProxyResolver (ForeignPtr ProxyResolver) noProxyResolver :: Maybe ProxyResolver noProxyResolver = Nothing foreign import ccall "g_proxy_resolver_get_type" c_g_proxy_resolver_get_type :: IO GType type instance ParentTypes ProxyResolver = '[GObject.Object] instance GObject ProxyResolver where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_proxy_resolver_get_type class GObject o => ProxyResolverK o instance (GObject o, IsDescendantOf ProxyResolver o) => ProxyResolverK o toProxyResolver :: ProxyResolverK o => o -> IO ProxyResolver toProxyResolver = unsafeCastTo ProxyResolver -- method ProxyResolver::is_supported -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_proxy_resolver_is_supported" g_proxy_resolver_is_supported :: Ptr ProxyResolver -> -- _obj : TInterface "Gio" "ProxyResolver" IO CInt proxyResolverIsSupported :: (MonadIO m, ProxyResolverK a) => a -> -- _obj m Bool proxyResolverIsSupported _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_proxy_resolver_is_supported _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method ProxyResolver::lookup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyResolver", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyResolver", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : True -- Skip return : False foreign import ccall "g_proxy_resolver_lookup" g_proxy_resolver_lookup :: Ptr ProxyResolver -> -- _obj : TInterface "Gio" "ProxyResolver" CString -> -- uri : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr CString) proxyResolverLookup :: (MonadIO m, ProxyResolverK a, CancellableK b) => a -> -- _obj T.Text -> -- uri Maybe (b) -> -- cancellable m [T.Text] proxyResolverLookup _obj uri cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_proxy_resolver_lookup _obj' uri' maybeCancellable checkUnexpectedReturnNULL "g_proxy_resolver_lookup" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem uri' return result' ) (do freeMem uri' ) -- method ProxyResolver::lookup_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyResolver", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "ProxyResolver", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_proxy_resolver_lookup_async" g_proxy_resolver_lookup_async :: Ptr ProxyResolver -> -- _obj : TInterface "Gio" "ProxyResolver" CString -> -- uri : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () proxyResolverLookupAsync :: (MonadIO m, ProxyResolverK a, CancellableK b) => a -> -- _obj T.Text -> -- uri Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () proxyResolverLookupAsync _obj uri cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_proxy_resolver_lookup_async _obj' uri' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem uri' return () -- method ProxyResolver::lookup_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_proxy_resolver_lookup_finish" g_proxy_resolver_lookup_finish :: Ptr ProxyResolver -> -- _obj : TInterface "Gio" "ProxyResolver" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr CString) proxyResolverLookupFinish :: (MonadIO m, ProxyResolverK a, AsyncResultK b) => a -> -- _obj b -> -- result m [T.Text] proxyResolverLookupFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_proxy_resolver_lookup_finish _obj' result_' checkUnexpectedReturnNULL "g_proxy_resolver_lookup_finish" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- interface RemoteActionGroup newtype RemoteActionGroup = RemoteActionGroup (ForeignPtr RemoteActionGroup) noRemoteActionGroup :: Maybe RemoteActionGroup noRemoteActionGroup = Nothing foreign import ccall "g_remote_action_group_get_type" c_g_remote_action_group_get_type :: IO GType type instance ParentTypes RemoteActionGroup = '[ActionGroup, GObject.Object] instance GObject RemoteActionGroup where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_remote_action_group_get_type class GObject o => RemoteActionGroupK o instance (GObject o, IsDescendantOf RemoteActionGroup o) => RemoteActionGroupK o toRemoteActionGroup :: RemoteActionGroupK o => o -> IO RemoteActionGroup toRemoteActionGroup = unsafeCastTo RemoteActionGroup -- method RemoteActionGroup::activate_action_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "RemoteActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameter", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "platform_data", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "RemoteActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameter", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "platform_data", 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_remote_action_group_activate_action_full" g_remote_action_group_activate_action_full :: Ptr RemoteActionGroup -> -- _obj : TInterface "Gio" "RemoteActionGroup" CString -> -- action_name : TBasicType TUTF8 Ptr GVariant -> -- parameter : TVariant Ptr GVariant -> -- platform_data : TVariant IO () remoteActionGroupActivateActionFull :: (MonadIO m, RemoteActionGroupK a) => a -> -- _obj T.Text -> -- action_name Maybe (GVariant) -> -- parameter GVariant -> -- platform_data m () remoteActionGroupActivateActionFull _obj action_name parameter platform_data = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name maybeParameter <- case parameter of Nothing -> return nullPtr Just jParameter -> do let jParameter' = unsafeManagedPtrGetPtr jParameter return jParameter' let platform_data' = unsafeManagedPtrGetPtr platform_data g_remote_action_group_activate_action_full _obj' action_name' maybeParameter platform_data' touchManagedPtr _obj freeMem action_name' return () -- method RemoteActionGroup::change_action_state_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "RemoteActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", 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},Arg {argName = "platform_data", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "RemoteActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", 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},Arg {argName = "platform_data", 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_remote_action_group_change_action_state_full" g_remote_action_group_change_action_state_full :: Ptr RemoteActionGroup -> -- _obj : TInterface "Gio" "RemoteActionGroup" CString -> -- action_name : TBasicType TUTF8 Ptr GVariant -> -- value : TVariant Ptr GVariant -> -- platform_data : TVariant IO () remoteActionGroupChangeActionStateFull :: (MonadIO m, RemoteActionGroupK a) => a -> -- _obj T.Text -> -- action_name GVariant -> -- value GVariant -> -- platform_data m () remoteActionGroupChangeActionStateFull _obj action_name value platform_data = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name let value' = unsafeManagedPtrGetPtr value let platform_data' = unsafeManagedPtrGetPtr platform_data g_remote_action_group_change_action_state_full _obj' action_name' value' platform_data' touchManagedPtr _obj freeMem action_name' return () -- object Resolver newtype Resolver = Resolver (ForeignPtr Resolver) noResolver :: Maybe Resolver noResolver = Nothing foreign import ccall "g_resolver_get_type" c_g_resolver_get_type :: IO GType type instance ParentTypes Resolver = '[GObject.Object] instance GObject Resolver where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_resolver_get_type class GObject o => ResolverK o instance (GObject o, IsDescendantOf Resolver o) => ResolverK o toResolver :: ResolverK o => o -> IO Resolver toResolver = unsafeCastTo Resolver -- method Resolver::lookup_by_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_resolver_lookup_by_address" g_resolver_lookup_by_address :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" Ptr InetAddress -> -- address : TInterface "Gio" "InetAddress" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CString resolverLookupByAddress :: (MonadIO m, ResolverK a, InetAddressK b, CancellableK c) => a -> -- _obj b -> -- address Maybe (c) -> -- cancellable m T.Text resolverLookupByAddress _obj address cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let address' = unsafeManagedPtrCastPtr address maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_resolver_lookup_by_address _obj' address' maybeCancellable checkUnexpectedReturnNULL "g_resolver_lookup_by_address" result result' <- cstringToText result freeMem result touchManagedPtr _obj touchManagedPtr address whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method Resolver::lookup_by_address_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_resolver_lookup_by_address_async" g_resolver_lookup_by_address_async :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" Ptr InetAddress -> -- address : TInterface "Gio" "InetAddress" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () resolverLookupByAddressAsync :: (MonadIO m, ResolverK a, InetAddressK b, CancellableK c) => a -> -- _obj b -> -- address Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () resolverLookupByAddressAsync _obj address cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let address' = unsafeManagedPtrCastPtr address maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_resolver_lookup_by_address_async _obj' address' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr address whenJust cancellable touchManagedPtr return () -- method Resolver::lookup_by_address_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_resolver_lookup_by_address_finish" g_resolver_lookup_by_address_finish :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CString resolverLookupByAddressFinish :: (MonadIO m, ResolverK a, AsyncResultK b) => a -> -- _obj b -> -- result m T.Text resolverLookupByAddressFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_resolver_lookup_by_address_finish _obj' result_' checkUnexpectedReturnNULL "g_resolver_lookup_by_address_finish" result result' <- cstringToText result freeMem result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method Resolver::lookup_by_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "InetAddress") -- throws : True -- Skip return : False foreign import ccall "g_resolver_lookup_by_name" g_resolver_lookup_by_name :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" CString -> -- hostname : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr InetAddress))) resolverLookupByName :: (MonadIO m, ResolverK a, CancellableK b) => a -> -- _obj T.Text -> -- hostname Maybe (b) -> -- cancellable m [InetAddress] resolverLookupByName _obj hostname cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj hostname' <- textToCString hostname maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_resolver_lookup_by_name _obj' hostname' maybeCancellable checkUnexpectedReturnNULL "g_resolver_lookup_by_name" result result' <- unpackGList result result'' <- mapM (wrapObject InetAddress) result' g_list_free result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem hostname' return result'' ) (do freeMem hostname' ) -- method Resolver::lookup_by_name_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_resolver_lookup_by_name_async" g_resolver_lookup_by_name_async :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" CString -> -- hostname : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () resolverLookupByNameAsync :: (MonadIO m, ResolverK a, CancellableK b) => a -> -- _obj T.Text -> -- hostname Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () resolverLookupByNameAsync _obj hostname cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj hostname' <- textToCString hostname maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_resolver_lookup_by_name_async _obj' hostname' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem hostname' return () -- method Resolver::lookup_by_name_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "InetAddress") -- throws : True -- Skip return : False foreign import ccall "g_resolver_lookup_by_name_finish" g_resolver_lookup_by_name_finish :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr InetAddress))) resolverLookupByNameFinish :: (MonadIO m, ResolverK a, AsyncResultK b) => a -> -- _obj b -> -- result m [InetAddress] resolverLookupByNameFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_resolver_lookup_by_name_finish _obj' result_' checkUnexpectedReturnNULL "g_resolver_lookup_by_name_finish" result result' <- unpackGList result result'' <- mapM (wrapObject InetAddress) result' g_list_free result touchManagedPtr _obj touchManagedPtr result_ return result'' ) (do return () ) -- method Resolver::lookup_records -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rrname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "record_type", argType = TInterface "Gio" "ResolverRecordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rrname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "record_type", argType = TInterface "Gio" "ResolverRecordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList TVariant -- throws : True -- Skip return : False foreign import ccall "g_resolver_lookup_records" g_resolver_lookup_records :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" CString -> -- rrname : TBasicType TUTF8 CUInt -> -- record_type : TInterface "Gio" "ResolverRecordType" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr GVariant))) resolverLookupRecords :: (MonadIO m, ResolverK a, CancellableK b) => a -> -- _obj T.Text -> -- rrname ResolverRecordType -> -- record_type Maybe (b) -> -- cancellable m [GVariant] resolverLookupRecords _obj rrname record_type cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj rrname' <- textToCString rrname let record_type' = (fromIntegral . fromEnum) record_type maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_resolver_lookup_records _obj' rrname' record_type' maybeCancellable checkUnexpectedReturnNULL "g_resolver_lookup_records" result result' <- unpackGList result result'' <- mapM wrapGVariantPtr result' g_list_free result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem rrname' return result'' ) (do freeMem rrname' ) -- method Resolver::lookup_records_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rrname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "record_type", argType = TInterface "Gio" "ResolverRecordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rrname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "record_type", argType = TInterface "Gio" "ResolverRecordType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_resolver_lookup_records_async" g_resolver_lookup_records_async :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" CString -> -- rrname : TBasicType TUTF8 CUInt -> -- record_type : TInterface "Gio" "ResolverRecordType" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () resolverLookupRecordsAsync :: (MonadIO m, ResolverK a, CancellableK b) => a -> -- _obj T.Text -> -- rrname ResolverRecordType -> -- record_type Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () resolverLookupRecordsAsync _obj rrname record_type cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj rrname' <- textToCString rrname let record_type' = (fromIntegral . fromEnum) record_type maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_resolver_lookup_records_async _obj' rrname' record_type' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem rrname' return () -- method Resolver::lookup_records_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList TVariant -- throws : True -- Skip return : False foreign import ccall "g_resolver_lookup_records_finish" g_resolver_lookup_records_finish :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr GVariant))) resolverLookupRecordsFinish :: (MonadIO m, ResolverK a, AsyncResultK b) => a -> -- _obj b -> -- result m [GVariant] resolverLookupRecordsFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_resolver_lookup_records_finish _obj' result_' checkUnexpectedReturnNULL "g_resolver_lookup_records_finish" result result' <- unpackGList result result'' <- mapM wrapGVariantPtr result' g_list_free result touchManagedPtr _obj touchManagedPtr result_ return result'' ) (do return () ) -- method Resolver::lookup_service -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "SrvTarget") -- throws : True -- Skip return : False foreign import ccall "g_resolver_lookup_service" g_resolver_lookup_service :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" CString -> -- service : TBasicType TUTF8 CString -> -- protocol : TBasicType TUTF8 CString -> -- domain : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr SrvTarget))) resolverLookupService :: (MonadIO m, ResolverK a, CancellableK b) => a -> -- _obj T.Text -> -- service T.Text -> -- protocol T.Text -> -- domain Maybe (b) -> -- cancellable m [SrvTarget] resolverLookupService _obj service protocol domain cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj service' <- textToCString service protocol' <- textToCString protocol domain' <- textToCString domain maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_resolver_lookup_service _obj' service' protocol' domain' maybeCancellable checkUnexpectedReturnNULL "g_resolver_lookup_service" result result' <- unpackGList result result'' <- mapM (wrapBoxed SrvTarget) result' g_list_free result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem service' freeMem protocol' freeMem domain' return result'' ) (do freeMem service' freeMem protocol' freeMem domain' ) -- method Resolver::lookup_service_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_resolver_lookup_service_async" g_resolver_lookup_service_async :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" CString -> -- service : TBasicType TUTF8 CString -> -- protocol : TBasicType TUTF8 CString -> -- domain : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () resolverLookupServiceAsync :: (MonadIO m, ResolverK a, CancellableK b) => a -> -- _obj T.Text -> -- service T.Text -> -- protocol T.Text -> -- domain Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () resolverLookupServiceAsync _obj service protocol domain cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj service' <- textToCString service protocol' <- textToCString protocol domain' <- textToCString domain maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_resolver_lookup_service_async _obj' service' protocol' domain' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem service' freeMem protocol' freeMem domain' return () -- method Resolver::lookup_service_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "SrvTarget") -- throws : True -- Skip return : False foreign import ccall "g_resolver_lookup_service_finish" g_resolver_lookup_service_finish :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr SrvTarget))) resolverLookupServiceFinish :: (MonadIO m, ResolverK a, AsyncResultK b) => a -> -- _obj b -> -- result m [SrvTarget] resolverLookupServiceFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_resolver_lookup_service_finish _obj' result_' checkUnexpectedReturnNULL "g_resolver_lookup_service_finish" result result' <- unpackGList result result'' <- mapM (wrapBoxed SrvTarget) result' g_list_free result touchManagedPtr _obj touchManagedPtr result_ return result'' ) (do return () ) -- method Resolver::set_default -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_resolver_set_default" g_resolver_set_default :: Ptr Resolver -> -- _obj : TInterface "Gio" "Resolver" IO () resolverSetDefault :: (MonadIO m, ResolverK a) => a -> -- _obj m () resolverSetDefault _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_resolver_set_default _obj' touchManagedPtr _obj return () -- method Resolver::get_default -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "Resolver" -- throws : False -- Skip return : False foreign import ccall "g_resolver_get_default" g_resolver_get_default :: IO (Ptr Resolver) resolverGetDefault :: (MonadIO m) => m Resolver resolverGetDefault = liftIO $ do result <- g_resolver_get_default checkUnexpectedReturnNULL "g_resolver_get_default" result result' <- (wrapObject Resolver) result return result' -- signal Resolver::reload type ResolverReloadCallback = IO () noResolverReloadCallback :: Maybe ResolverReloadCallback noResolverReloadCallback = Nothing type ResolverReloadCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkResolverReloadCallback :: ResolverReloadCallbackC -> IO (FunPtr ResolverReloadCallbackC) resolverReloadClosure :: ResolverReloadCallback -> IO Closure resolverReloadClosure cb = newCClosure =<< mkResolverReloadCallback wrapped where wrapped = resolverReloadCallbackWrapper cb resolverReloadCallbackWrapper :: ResolverReloadCallback -> Ptr () -> Ptr () -> IO () resolverReloadCallbackWrapper _cb _ _ = do _cb onResolverReload :: (GObject a, MonadIO m) => a -> ResolverReloadCallback -> m SignalHandlerId onResolverReload obj cb = liftIO $ connectResolverReload obj cb SignalConnectBefore afterResolverReload :: (GObject a, MonadIO m) => a -> ResolverReloadCallback -> m SignalHandlerId afterResolverReload obj cb = connectResolverReload obj cb SignalConnectAfter connectResolverReload :: (GObject a, MonadIO m) => a -> ResolverReloadCallback -> SignalConnectMode -> m SignalHandlerId connectResolverReload obj cb after = liftIO $ do cb' <- mkResolverReloadCallback (resolverReloadCallbackWrapper cb) connectSignalFunPtr obj "reload" cb' after -- Enum ResolverError data ResolverError = ResolverErrorNotFound | ResolverErrorTemporaryFailure | ResolverErrorInternal | AnotherResolverError Int deriving (Show, Eq) instance Enum ResolverError where fromEnum ResolverErrorNotFound = 0 fromEnum ResolverErrorTemporaryFailure = 1 fromEnum ResolverErrorInternal = 2 fromEnum (AnotherResolverError k) = k toEnum 0 = ResolverErrorNotFound toEnum 1 = ResolverErrorTemporaryFailure toEnum 2 = ResolverErrorInternal toEnum k = AnotherResolverError k instance GErrorClass ResolverError where gerrorClassDomain _ = "g-resolver-error-quark" catchResolverError :: IO a -> (ResolverError -> GErrorMessage -> IO a) -> IO a catchResolverError = catchGErrorJustDomain handleResolverError :: (ResolverError -> GErrorMessage -> IO a) -> IO a -> IO a handleResolverError = handleGErrorJustDomain foreign import ccall "g_resolver_error_get_type" c_g_resolver_error_get_type :: IO GType instance BoxedEnum ResolverError where boxedEnumType _ = c_g_resolver_error_get_type -- Enum ResolverRecordType data ResolverRecordType = ResolverRecordTypeSrv | ResolverRecordTypeMx | ResolverRecordTypeTxt | ResolverRecordTypeSoa | ResolverRecordTypeNs | AnotherResolverRecordType Int deriving (Show, Eq) instance Enum ResolverRecordType where fromEnum ResolverRecordTypeSrv = 1 fromEnum ResolverRecordTypeMx = 2 fromEnum ResolverRecordTypeTxt = 3 fromEnum ResolverRecordTypeSoa = 4 fromEnum ResolverRecordTypeNs = 5 fromEnum (AnotherResolverRecordType k) = k toEnum 1 = ResolverRecordTypeSrv toEnum 2 = ResolverRecordTypeMx toEnum 3 = ResolverRecordTypeTxt toEnum 4 = ResolverRecordTypeSoa toEnum 5 = ResolverRecordTypeNs toEnum k = AnotherResolverRecordType k foreign import ccall "g_resolver_record_type_get_type" c_g_resolver_record_type_get_type :: IO GType instance BoxedEnum ResolverRecordType where boxedEnumType _ = c_g_resolver_record_type_get_type -- struct Resource newtype Resource = Resource (ForeignPtr Resource) noResource :: Maybe Resource noResource = Nothing foreign import ccall "g_resource_get_type" c_g_resource_get_type :: IO GType instance BoxedObject Resource where boxedType _ = c_g_resource_get_type -- method Resource::new_from_data -- method type : Constructor -- Args : [Arg {argName = "data", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "data", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Resource" -- throws : True -- Skip return : False foreign import ccall "g_resource_new_from_data" g_resource_new_from_data :: Ptr GLib.Bytes -> -- data : TInterface "GLib" "Bytes" Ptr (Ptr GError) -> -- error IO (Ptr Resource) resourceNewFromData :: (MonadIO m) => GLib.Bytes -> -- data m Resource resourceNewFromData data_ = liftIO $ do let data_' = unsafeManagedPtrGetPtr data_ onException (do result <- propagateGError $ g_resource_new_from_data data_' checkUnexpectedReturnNULL "g_resource_new_from_data" result result' <- (wrapBoxed Resource) result touchManagedPtr data_ return result' ) (do return () ) -- method Resource::enumerate_children -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", 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_resource_enumerate_children" g_resource_enumerate_children :: Ptr Resource -> -- _obj : TInterface "Gio" "Resource" CString -> -- path : TBasicType TUTF8 CUInt -> -- lookup_flags : TInterface "Gio" "ResourceLookupFlags" Ptr (Ptr GError) -> -- error IO (Ptr CString) resourceEnumerateChildren :: (MonadIO m) => Resource -> -- _obj T.Text -> -- path [ResourceLookupFlags] -> -- lookup_flags m [T.Text] resourceEnumerateChildren _obj path lookup_flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj path' <- textToCString path let lookup_flags' = gflagsToWord lookup_flags onException (do result <- propagateGError $ g_resource_enumerate_children _obj' path' lookup_flags' checkUnexpectedReturnNULL "g_resource_enumerate_children" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj freeMem path' return result' ) (do freeMem path' ) -- method Resource::get_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", 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},Arg {argName = "flags", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_resource_get_info" g_resource_get_info :: Ptr Resource -> -- _obj : TInterface "Gio" "Resource" CString -> -- path : TBasicType TUTF8 CUInt -> -- lookup_flags : TInterface "Gio" "ResourceLookupFlags" Ptr Word64 -> -- size : TBasicType TUInt64 Ptr Word32 -> -- flags : TBasicType TUInt32 Ptr (Ptr GError) -> -- error IO CInt resourceGetInfo :: (MonadIO m) => Resource -> -- _obj T.Text -> -- path [ResourceLookupFlags] -> -- lookup_flags m (Word64,Word32) resourceGetInfo _obj path lookup_flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj path' <- textToCString path let lookup_flags' = gflagsToWord lookup_flags size <- allocMem :: IO (Ptr Word64) flags <- allocMem :: IO (Ptr Word32) onException (do _ <- propagateGError $ g_resource_get_info _obj' path' lookup_flags' size flags size' <- peek size flags' <- peek flags touchManagedPtr _obj freeMem path' freeMem size freeMem flags return (size', flags') ) (do freeMem path' freeMem size freeMem flags ) -- method Resource::lookup_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : True -- Skip return : False foreign import ccall "g_resource_lookup_data" g_resource_lookup_data :: Ptr Resource -> -- _obj : TInterface "Gio" "Resource" CString -> -- path : TBasicType TUTF8 CUInt -> -- lookup_flags : TInterface "Gio" "ResourceLookupFlags" Ptr (Ptr GError) -> -- error IO (Ptr GLib.Bytes) resourceLookupData :: (MonadIO m) => Resource -> -- _obj T.Text -> -- path [ResourceLookupFlags] -> -- lookup_flags m GLib.Bytes resourceLookupData _obj path lookup_flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj path' <- textToCString path let lookup_flags' = gflagsToWord lookup_flags onException (do result <- propagateGError $ g_resource_lookup_data _obj' path' lookup_flags' checkUnexpectedReturnNULL "g_resource_lookup_data" result result' <- (wrapBoxed GLib.Bytes) result touchManagedPtr _obj freeMem path' return result' ) (do freeMem path' ) -- method Resource::open_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : True -- Skip return : False foreign import ccall "g_resource_open_stream" g_resource_open_stream :: Ptr Resource -> -- _obj : TInterface "Gio" "Resource" CString -> -- path : TBasicType TUTF8 CUInt -> -- lookup_flags : TInterface "Gio" "ResourceLookupFlags" Ptr (Ptr GError) -> -- error IO (Ptr InputStream) resourceOpenStream :: (MonadIO m) => Resource -> -- _obj T.Text -> -- path [ResourceLookupFlags] -> -- lookup_flags m InputStream resourceOpenStream _obj path lookup_flags = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj path' <- textToCString path let lookup_flags' = gflagsToWord lookup_flags onException (do result <- propagateGError $ g_resource_open_stream _obj' path' lookup_flags' checkUnexpectedReturnNULL "g_resource_open_stream" result result' <- (wrapObject InputStream) result touchManagedPtr _obj freeMem path' return result' ) (do freeMem path' ) -- method Resource::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Resource" -- throws : False -- Skip return : False foreign import ccall "g_resource_ref" g_resource_ref :: Ptr Resource -> -- _obj : TInterface "Gio" "Resource" IO (Ptr Resource) resourceRef :: (MonadIO m) => Resource -> -- _obj m Resource resourceRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_resource_ref _obj' checkUnexpectedReturnNULL "g_resource_ref" result result' <- (wrapBoxed Resource) result touchManagedPtr _obj return result' -- method Resource::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_resource_unref" g_resource_unref :: Ptr Resource -> -- _obj : TInterface "Gio" "Resource" IO () resourceUnref :: (MonadIO m) => Resource -> -- _obj m () resourceUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_resource_unref _obj' touchManagedPtr _obj return () -- Enum ResourceError data ResourceError = ResourceErrorNotFound | ResourceErrorInternal | AnotherResourceError Int deriving (Show, Eq) instance Enum ResourceError where fromEnum ResourceErrorNotFound = 0 fromEnum ResourceErrorInternal = 1 fromEnum (AnotherResourceError k) = k toEnum 0 = ResourceErrorNotFound toEnum 1 = ResourceErrorInternal toEnum k = AnotherResourceError k instance GErrorClass ResourceError where gerrorClassDomain _ = "g-resource-error-quark" catchResourceError :: IO a -> (ResourceError -> GErrorMessage -> IO a) -> IO a catchResourceError = catchGErrorJustDomain handleResourceError :: (ResourceError -> GErrorMessage -> IO a) -> IO a -> IO a handleResourceError = handleGErrorJustDomain foreign import ccall "g_resource_error_get_type" c_g_resource_error_get_type :: IO GType instance BoxedEnum ResourceError where boxedEnumType _ = c_g_resource_error_get_type -- Flags ResourceFlags data ResourceFlags = ResourceFlagsNone | ResourceFlagsCompressed | AnotherResourceFlags Int deriving (Show, Eq) instance Enum ResourceFlags where fromEnum ResourceFlagsNone = 0 fromEnum ResourceFlagsCompressed = 1 fromEnum (AnotherResourceFlags k) = k toEnum 0 = ResourceFlagsNone toEnum 1 = ResourceFlagsCompressed toEnum k = AnotherResourceFlags k foreign import ccall "g_resource_flags_get_type" c_g_resource_flags_get_type :: IO GType instance BoxedEnum ResourceFlags where boxedEnumType _ = c_g_resource_flags_get_type instance IsGFlag ResourceFlags -- Flags ResourceLookupFlags data ResourceLookupFlags = ResourceLookupFlagsNone | AnotherResourceLookupFlags Int deriving (Show, Eq) instance Enum ResourceLookupFlags where fromEnum ResourceLookupFlagsNone = 0 fromEnum (AnotherResourceLookupFlags k) = k toEnum 0 = ResourceLookupFlagsNone toEnum k = AnotherResourceLookupFlags k foreign import ccall "g_resource_lookup_flags_get_type" c_g_resource_lookup_flags_get_type :: IO GType instance BoxedEnum ResourceLookupFlags where boxedEnumType _ = c_g_resource_lookup_flags_get_type instance IsGFlag ResourceLookupFlags -- interface Seekable newtype Seekable = Seekable (ForeignPtr Seekable) noSeekable :: Maybe Seekable noSeekable = Nothing foreign import ccall "g_seekable_get_type" c_g_seekable_get_type :: IO GType type instance ParentTypes Seekable = '[GObject.Object] instance GObject Seekable where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_seekable_get_type class GObject o => SeekableK o instance (GObject o, IsDescendantOf Seekable o) => SeekableK o toSeekable :: SeekableK o => o -> IO Seekable toSeekable = unsafeCastTo Seekable -- method Seekable::can_seek -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_seekable_can_seek" g_seekable_can_seek :: Ptr Seekable -> -- _obj : TInterface "Gio" "Seekable" IO CInt seekableCanSeek :: (MonadIO m, SeekableK a) => a -> -- _obj m Bool seekableCanSeek _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_seekable_can_seek _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Seekable::can_truncate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_seekable_can_truncate" g_seekable_can_truncate :: Ptr Seekable -> -- _obj : TInterface "Gio" "Seekable" IO CInt seekableCanTruncate :: (MonadIO m, SeekableK a) => a -> -- _obj m Bool seekableCanTruncate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_seekable_can_truncate _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Seekable::seek -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_seekable_seek" g_seekable_seek :: Ptr Seekable -> -- _obj : TInterface "Gio" "Seekable" Int64 -> -- offset : TBasicType TInt64 CUInt -> -- type : TInterface "GLib" "SeekType" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt seekableSeek :: (MonadIO m, SeekableK a, CancellableK b) => a -> -- _obj Int64 -> -- offset GLib.SeekType -> -- type Maybe (b) -> -- cancellable m () seekableSeek _obj offset type_ cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let type_' = (fromIntegral . fromEnum) type_ maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_seekable_seek _obj' offset type_' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Seekable::tell -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_seekable_tell" g_seekable_tell :: Ptr Seekable -> -- _obj : TInterface "Gio" "Seekable" IO Int64 seekableTell :: (MonadIO m, SeekableK a) => a -> -- _obj m Int64 seekableTell _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_seekable_tell _obj' touchManagedPtr _obj return result -- method Seekable::truncate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Seekable", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_seekable_truncate" g_seekable_truncate :: Ptr Seekable -> -- _obj : TInterface "Gio" "Seekable" Int64 -> -- offset : TBasicType TInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt seekableTruncate :: (MonadIO m, SeekableK a, CancellableK b) => a -> -- _obj Int64 -> -- offset Maybe (b) -> -- cancellable m () seekableTruncate _obj offset cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_seekable_truncate _obj' offset maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- object Settings newtype Settings = Settings (ForeignPtr Settings) noSettings :: Maybe Settings noSettings = Nothing foreign import ccall "g_settings_get_type" c_g_settings_get_type :: IO GType type instance ParentTypes Settings = '[GObject.Object] instance GObject Settings where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_settings_get_type class GObject o => SettingsK o instance (GObject o, IsDescendantOf Settings o) => SettingsK o toSettings :: SettingsK o => o -> IO Settings toSettings = unsafeCastTo Settings -- method Settings::new -- method type : Constructor -- Args : [Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Settings" -- throws : False -- Skip return : False foreign import ccall "g_settings_new" g_settings_new :: CString -> -- schema_id : TBasicType TUTF8 IO (Ptr Settings) settingsNew :: (MonadIO m) => T.Text -> -- schema_id m Settings settingsNew schema_id = liftIO $ do schema_id' <- textToCString schema_id result <- g_settings_new schema_id' checkUnexpectedReturnNULL "g_settings_new" result result' <- (wrapObject Settings) result freeMem schema_id' return result' -- method Settings::new_full -- method type : Constructor -- Args : [Arg {argName = "schema", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "backend", argType = TInterface "Gio" "SettingsBackend", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "schema", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "backend", argType = TInterface "Gio" "SettingsBackend", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Settings" -- throws : False -- Skip return : False foreign import ccall "g_settings_new_full" g_settings_new_full :: Ptr SettingsSchema -> -- schema : TInterface "Gio" "SettingsSchema" Ptr SettingsBackend -> -- backend : TInterface "Gio" "SettingsBackend" CString -> -- path : TBasicType TUTF8 IO (Ptr Settings) settingsNewFull :: (MonadIO m) => SettingsSchema -> -- schema Maybe (SettingsBackend) -> -- backend Maybe (T.Text) -> -- path m Settings settingsNewFull schema backend path = liftIO $ do let schema' = unsafeManagedPtrGetPtr schema maybeBackend <- case backend of Nothing -> return nullPtr Just jBackend -> do let jBackend' = unsafeManagedPtrGetPtr jBackend return jBackend' maybePath <- case path of Nothing -> return nullPtr Just jPath -> do jPath' <- textToCString jPath return jPath' result <- g_settings_new_full schema' maybeBackend maybePath checkUnexpectedReturnNULL "g_settings_new_full" result result' <- (wrapObject Settings) result touchManagedPtr schema whenJust backend touchManagedPtr freeMem maybePath return result' -- method Settings::new_with_backend -- method type : Constructor -- Args : [Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "backend", argType = TInterface "Gio" "SettingsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "backend", argType = TInterface "Gio" "SettingsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Settings" -- throws : False -- Skip return : False foreign import ccall "g_settings_new_with_backend" g_settings_new_with_backend :: CString -> -- schema_id : TBasicType TUTF8 Ptr SettingsBackend -> -- backend : TInterface "Gio" "SettingsBackend" IO (Ptr Settings) settingsNewWithBackend :: (MonadIO m) => T.Text -> -- schema_id SettingsBackend -> -- backend m Settings settingsNewWithBackend schema_id backend = liftIO $ do schema_id' <- textToCString schema_id let backend' = unsafeManagedPtrGetPtr backend result <- g_settings_new_with_backend schema_id' backend' checkUnexpectedReturnNULL "g_settings_new_with_backend" result result' <- (wrapObject Settings) result touchManagedPtr backend freeMem schema_id' return result' -- method Settings::new_with_backend_and_path -- method type : Constructor -- Args : [Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "backend", argType = TInterface "Gio" "SettingsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "backend", argType = TInterface "Gio" "SettingsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Settings" -- throws : False -- Skip return : False foreign import ccall "g_settings_new_with_backend_and_path" g_settings_new_with_backend_and_path :: CString -> -- schema_id : TBasicType TUTF8 Ptr SettingsBackend -> -- backend : TInterface "Gio" "SettingsBackend" CString -> -- path : TBasicType TUTF8 IO (Ptr Settings) settingsNewWithBackendAndPath :: (MonadIO m) => T.Text -> -- schema_id SettingsBackend -> -- backend T.Text -> -- path m Settings settingsNewWithBackendAndPath schema_id backend path = liftIO $ do schema_id' <- textToCString schema_id let backend' = unsafeManagedPtrGetPtr backend path' <- textToCString path result <- g_settings_new_with_backend_and_path schema_id' backend' path' checkUnexpectedReturnNULL "g_settings_new_with_backend_and_path" result result' <- (wrapObject Settings) result touchManagedPtr backend freeMem schema_id' freeMem path' return result' -- method Settings::new_with_path -- method type : Constructor -- Args : [Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Settings" -- throws : False -- Skip return : False foreign import ccall "g_settings_new_with_path" g_settings_new_with_path :: CString -> -- schema_id : TBasicType TUTF8 CString -> -- path : TBasicType TUTF8 IO (Ptr Settings) settingsNewWithPath :: (MonadIO m) => T.Text -> -- schema_id T.Text -> -- path m Settings settingsNewWithPath schema_id path = liftIO $ do schema_id' <- textToCString schema_id path' <- textToCString path result <- g_settings_new_with_path schema_id' path' checkUnexpectedReturnNULL "g_settings_new_with_path" result result' <- (wrapObject Settings) result freeMem schema_id' freeMem path' return result' -- method Settings::apply -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_apply" g_settings_apply :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" IO () settingsApply :: (MonadIO m, SettingsK a) => a -> -- _obj m () settingsApply _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_settings_apply _obj' touchManagedPtr _obj return () -- method Settings::bind -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "SettingsBindFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "SettingsBindFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_bind" g_settings_bind :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Ptr GObject.Object -> -- object : TInterface "GObject" "Object" CString -> -- property : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "SettingsBindFlags" IO () settingsBind :: (MonadIO m, SettingsK a, GObject.ObjectK b) => a -> -- _obj T.Text -> -- key b -> -- object T.Text -> -- property [SettingsBindFlags] -> -- flags m () settingsBind _obj key object property flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key let object' = unsafeManagedPtrCastPtr object property' <- textToCString property let flags' = gflagsToWord flags g_settings_bind _obj' key' object' property' flags' touchManagedPtr _obj touchManagedPtr object freeMem key' freeMem property' return () -- method Settings::bind_writable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inverted", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inverted", 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_settings_bind_writable" g_settings_bind_writable :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Ptr GObject.Object -> -- object : TInterface "GObject" "Object" CString -> -- property : TBasicType TUTF8 CInt -> -- inverted : TBasicType TBoolean IO () settingsBindWritable :: (MonadIO m, SettingsK a, GObject.ObjectK b) => a -> -- _obj T.Text -> -- key b -> -- object T.Text -> -- property Bool -> -- inverted m () settingsBindWritable _obj key object property inverted = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key let object' = unsafeManagedPtrCastPtr object property' <- textToCString property let inverted' = (fromIntegral . fromEnum) inverted g_settings_bind_writable _obj' key' object' property' inverted' touchManagedPtr _obj touchManagedPtr object freeMem key' freeMem property' return () -- method Settings::create_action -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : TInterface "Gio" "Action" -- throws : False -- Skip return : False foreign import ccall "g_settings_create_action" g_settings_create_action :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO (Ptr Action) settingsCreateAction :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m Action settingsCreateAction _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_create_action _obj' key' checkUnexpectedReturnNULL "g_settings_create_action" result result' <- (wrapObject Action) result touchManagedPtr _obj freeMem key' return result' -- method Settings::delay -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_delay" g_settings_delay :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" IO () settingsDelay :: (MonadIO m, SettingsK a) => a -> -- _obj m () settingsDelay _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_settings_delay _obj' touchManagedPtr _obj return () -- method Settings::get_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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_settings_get_boolean" g_settings_get_boolean :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO CInt settingsGetBoolean :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m Bool settingsGetBoolean _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_boolean _obj' key' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::get_child -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : TInterface "Gio" "Settings" -- throws : False -- Skip return : False foreign import ccall "g_settings_get_child" g_settings_get_child :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- name : TBasicType TUTF8 IO (Ptr Settings) settingsGetChild :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- name m Settings settingsGetChild _obj name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- textToCString name result <- g_settings_get_child _obj' name' checkUnexpectedReturnNULL "g_settings_get_child" result result' <- (wrapObject Settings) result touchManagedPtr _obj freeMem name' return result' -- method Settings::get_default_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : TVariant -- throws : False -- Skip return : False foreign import ccall "g_settings_get_default_value" g_settings_get_default_value :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO (Ptr GVariant) settingsGetDefaultValue :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m GVariant settingsGetDefaultValue _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_default_value _obj' key' checkUnexpectedReturnNULL "g_settings_get_default_value" result result' <- wrapGVariantPtr result touchManagedPtr _obj freeMem key' return result' -- method Settings::get_double -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : False -- Skip return : False foreign import ccall "g_settings_get_double" g_settings_get_double :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO CDouble settingsGetDouble :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m Double settingsGetDouble _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_double _obj' key' let result' = realToFrac result touchManagedPtr _obj freeMem key' return result' -- method Settings::get_enum -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : False -- Skip return : False foreign import ccall "g_settings_get_enum" g_settings_get_enum :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO Int32 settingsGetEnum :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m Int32 settingsGetEnum _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_enum _obj' key' touchManagedPtr _obj freeMem key' return result -- method Settings::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_settings_get_flags" g_settings_get_flags :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO Word32 settingsGetFlags :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m Word32 settingsGetFlags _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_flags _obj' key' touchManagedPtr _obj freeMem key' return result -- method Settings::get_has_unapplied -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_get_has_unapplied" g_settings_get_has_unapplied :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" IO CInt settingsGetHasUnapplied :: (MonadIO m, SettingsK a) => a -> -- _obj m Bool settingsGetHasUnapplied _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_settings_get_has_unapplied _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Settings::get_int -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : False -- Skip return : False foreign import ccall "g_settings_get_int" g_settings_get_int :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO Int32 settingsGetInt :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m Int32 settingsGetInt _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_int _obj' key' touchManagedPtr _obj freeMem key' return result -- method Settings::get_mapped -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 = "mapping", argType = TInterface "Gio" "SettingsGetMapping", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 3, 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 "Gio" "Settings", 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 = "mapping", argType = TInterface "Gio" "SettingsGetMapping", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_get_mapped" g_settings_get_mapped :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 FunPtr SettingsGetMappingC -> -- mapping : TInterface "Gio" "SettingsGetMapping" Ptr () -> -- user_data : TBasicType TVoid IO () settingsGetMapped :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key SettingsGetMapping -> -- mapping m () settingsGetMapped _obj key mapping = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key mapping' <- mkSettingsGetMapping (settingsGetMappingWrapper Nothing mapping) let user_data = nullPtr g_settings_get_mapped _obj' key' mapping' user_data safeFreeFunPtr $ castFunPtrToPtr mapping' touchManagedPtr _obj freeMem key' return () -- method Settings::get_range -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : TVariant -- throws : False -- Skip return : False foreign import ccall "g_settings_get_range" g_settings_get_range :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO (Ptr GVariant) {-# DEPRECATED settingsGetRange ["(Since version 2.40)","Use g_settings_schema_key_get_range() instead."]#-} settingsGetRange :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m GVariant settingsGetRange _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_range _obj' key' checkUnexpectedReturnNULL "g_settings_get_range" result result' <- wrapGVariantPtr result touchManagedPtr _obj freeMem key' return result' -- method Settings::get_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : False -- Skip return : False foreign import ccall "g_settings_get_string" g_settings_get_string :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO CString settingsGetString :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m T.Text settingsGetString _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_string _obj' key' checkUnexpectedReturnNULL "g_settings_get_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem key' return result' -- method Settings::get_strv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_settings_get_strv" g_settings_get_strv :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO (Ptr CString) settingsGetStrv :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m [T.Text] settingsGetStrv _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_strv _obj' key' checkUnexpectedReturnNULL "g_settings_get_strv" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj freeMem key' return result' -- method Settings::get_uint -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_settings_get_uint" g_settings_get_uint :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO Word32 settingsGetUint :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m Word32 settingsGetUint _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_uint _obj' key' touchManagedPtr _obj freeMem key' return result -- method Settings::get_user_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : TVariant -- throws : False -- Skip return : False foreign import ccall "g_settings_get_user_value" g_settings_get_user_value :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO (Ptr GVariant) settingsGetUserValue :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m GVariant settingsGetUserValue _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_user_value _obj' key' checkUnexpectedReturnNULL "g_settings_get_user_value" result result' <- wrapGVariantPtr result touchManagedPtr _obj freeMem key' return result' -- method Settings::get_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 : TVariant -- throws : False -- Skip return : False foreign import ccall "g_settings_get_value" g_settings_get_value :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO (Ptr GVariant) settingsGetValue :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m GVariant settingsGetValue _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_get_value _obj' key' checkUnexpectedReturnNULL "g_settings_get_value" result result' <- wrapGVariantPtr result touchManagedPtr _obj freeMem key' return result' -- method Settings::is_writable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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_settings_is_writable" g_settings_is_writable :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- name : TBasicType TUTF8 IO CInt settingsIsWritable :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- name m Bool settingsIsWritable _obj name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- textToCString name result <- g_settings_is_writable _obj' name' let result' = (/= 0) result touchManagedPtr _obj freeMem name' return result' -- method Settings::list_children -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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_settings_list_children" g_settings_list_children :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" IO (Ptr CString) settingsListChildren :: (MonadIO m, SettingsK a) => a -> -- _obj m [T.Text] settingsListChildren _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_settings_list_children _obj' checkUnexpectedReturnNULL "g_settings_list_children" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method Settings::list_keys -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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_settings_list_keys" g_settings_list_keys :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" IO (Ptr CString) settingsListKeys :: (MonadIO m, SettingsK a) => a -> -- _obj m [T.Text] settingsListKeys _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_settings_list_keys _obj' checkUnexpectedReturnNULL "g_settings_list_keys" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method Settings::range_check -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_range_check" g_settings_range_check :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Ptr GVariant -> -- value : TVariant IO CInt {-# DEPRECATED settingsRangeCheck ["(Since version 2.40)","Use g_settings_schema_key_range_check() instead."]#-} settingsRangeCheck :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key GVariant -> -- value m Bool settingsRangeCheck _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key let value' = unsafeManagedPtrGetPtr value result <- g_settings_range_check _obj' key' value' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::reset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_reset" g_settings_reset :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 IO () settingsReset :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key m () settingsReset _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key g_settings_reset _obj' key' touchManagedPtr _obj freeMem key' return () -- method Settings::revert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_revert" g_settings_revert :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" IO () settingsRevert :: (MonadIO m, SettingsK a) => a -> -- _obj m () settingsRevert _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_settings_revert _obj' touchManagedPtr _obj return () -- method Settings::set_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_set_boolean" g_settings_set_boolean :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 CInt -> -- value : TBasicType TBoolean IO CInt settingsSetBoolean :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key Bool -> -- value m Bool settingsSetBoolean _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key let value' = (fromIntegral . fromEnum) value result <- g_settings_set_boolean _obj' key' value' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::set_double -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_set_double" g_settings_set_double :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 CDouble -> -- value : TBasicType TDouble IO CInt settingsSetDouble :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key Double -> -- value m Bool settingsSetDouble _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key let value' = realToFrac value result <- g_settings_set_double _obj' key' value' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::set_enum -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_set_enum" g_settings_set_enum :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Int32 -> -- value : TBasicType TInt32 IO CInt settingsSetEnum :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key Int32 -> -- value m Bool settingsSetEnum _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_set_enum _obj' key' value let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::set_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 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_settings_set_flags" g_settings_set_flags :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Word32 -> -- value : TBasicType TUInt32 IO CInt settingsSetFlags :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key Word32 -> -- value m Bool settingsSetFlags _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_set_flags _obj' key' value let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::set_int -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_set_int" g_settings_set_int :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Int32 -> -- value : TBasicType TInt32 IO CInt settingsSetInt :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key Int32 -> -- value m Bool settingsSetInt _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_set_int _obj' key' value let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::set_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_set_string" g_settings_set_string :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 CString -> -- value : TBasicType TUTF8 IO CInt settingsSetString :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key T.Text -> -- value m Bool settingsSetString _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key value' <- textToCString value result <- g_settings_set_string _obj' key' value' let result' = (/= 0) result touchManagedPtr _obj freeMem key' freeMem value' return result' -- method Settings::set_strv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 = TCArray True (-1) (-1) (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_settings_set_strv" g_settings_set_strv :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Ptr CString -> -- value : TCArray True (-1) (-1) (TBasicType TUTF8) IO CInt settingsSetStrv :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key Maybe ([T.Text]) -> -- value m Bool settingsSetStrv _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do jValue' <- packZeroTerminatedUTF8CArray jValue return jValue' result <- g_settings_set_strv _obj' key' maybeValue let result' = (/= 0) result touchManagedPtr _obj freeMem key' mapZeroTerminatedCArray freeMem maybeValue freeMem maybeValue return result' -- method Settings::set_uint -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 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_settings_set_uint" g_settings_set_uint :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Word32 -> -- value : TBasicType TUInt32 IO CInt settingsSetUint :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key Word32 -> -- value m Bool settingsSetUint _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key result <- g_settings_set_uint _obj' key' value let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::set_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Settings", 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 "Gio" "Settings", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_set_value" g_settings_set_value :: Ptr Settings -> -- _obj : TInterface "Gio" "Settings" CString -> -- key : TBasicType TUTF8 Ptr GVariant -> -- value : TVariant IO CInt settingsSetValue :: (MonadIO m, SettingsK a) => a -> -- _obj T.Text -> -- key GVariant -> -- value m Bool settingsSetValue _obj key value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key let value' = unsafeManagedPtrGetPtr value result <- g_settings_set_value _obj' key' value' let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Settings::list_relocatable_schemas -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_settings_list_relocatable_schemas" g_settings_list_relocatable_schemas :: IO (Ptr CString) {-# DEPRECATED settingsListRelocatableSchemas ["(Since version 2.40)","Use g_settings_schema_source_list_schemas() instead"]#-} settingsListRelocatableSchemas :: (MonadIO m) => m [T.Text] settingsListRelocatableSchemas = liftIO $ do result <- g_settings_list_relocatable_schemas checkUnexpectedReturnNULL "g_settings_list_relocatable_schemas" result result' <- unpackZeroTerminatedUTF8CArray result return result' -- method Settings::list_schemas -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_settings_list_schemas" g_settings_list_schemas :: IO (Ptr CString) {-# DEPRECATED settingsListSchemas ["(Since version 2.40)","Use g_settings_schema_source_list_schemas() instead.","If you used g_settings_list_schemas() to check for the presence of","a particular schema, use g_settings_schema_source_lookup() instead","of your whole loop."]#-} settingsListSchemas :: (MonadIO m) => m [T.Text] settingsListSchemas = liftIO $ do result <- g_settings_list_schemas checkUnexpectedReturnNULL "g_settings_list_schemas" result result' <- unpackZeroTerminatedUTF8CArray result return result' -- method Settings::sync -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_sync" g_settings_sync :: IO () settingsSync :: (MonadIO m) => m () settingsSync = liftIO $ do g_settings_sync return () -- method Settings::unbind -- method type : MemberFunction -- Args : [Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", 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_settings_unbind" g_settings_unbind :: Ptr GObject.Object -> -- object : TInterface "GObject" "Object" CString -> -- property : TBasicType TUTF8 IO () settingsUnbind :: (MonadIO m, GObject.ObjectK a) => a -> -- object T.Text -> -- property m () settingsUnbind object property = liftIO $ do let object' = unsafeManagedPtrCastPtr object property' <- textToCString property g_settings_unbind object' property' touchManagedPtr object freeMem property' return () -- signal Settings::change-event type SettingsChangeEventCallback = Maybe [Word32] -> IO Bool noSettingsChangeEventCallback :: Maybe SettingsChangeEventCallback noSettingsChangeEventCallback = Nothing type SettingsChangeEventCallbackC = Ptr () -> -- object Ptr Word32 -> Int32 -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkSettingsChangeEventCallback :: SettingsChangeEventCallbackC -> IO (FunPtr SettingsChangeEventCallbackC) settingsChangeEventClosure :: SettingsChangeEventCallback -> IO Closure settingsChangeEventClosure cb = newCClosure =<< mkSettingsChangeEventCallback wrapped where wrapped = settingsChangeEventCallbackWrapper cb settingsChangeEventCallbackWrapper :: SettingsChangeEventCallback -> Ptr () -> Ptr Word32 -> Int32 -> Ptr () -> IO CInt settingsChangeEventCallbackWrapper _cb _ keys n_keys _ = do maybeKeys <- if keys == nullPtr then return Nothing else do keys' <- (unpackStorableArrayWithLength n_keys) keys return $ Just keys' result <- _cb maybeKeys let result' = (fromIntegral . fromEnum) result return result' onSettingsChangeEvent :: (GObject a, MonadIO m) => a -> SettingsChangeEventCallback -> m SignalHandlerId onSettingsChangeEvent obj cb = liftIO $ connectSettingsChangeEvent obj cb SignalConnectBefore afterSettingsChangeEvent :: (GObject a, MonadIO m) => a -> SettingsChangeEventCallback -> m SignalHandlerId afterSettingsChangeEvent obj cb = connectSettingsChangeEvent obj cb SignalConnectAfter connectSettingsChangeEvent :: (GObject a, MonadIO m) => a -> SettingsChangeEventCallback -> SignalConnectMode -> m SignalHandlerId connectSettingsChangeEvent obj cb after = liftIO $ do cb' <- mkSettingsChangeEventCallback (settingsChangeEventCallbackWrapper cb) connectSignalFunPtr obj "change-event" cb' after -- signal Settings::changed type SettingsChangedCallback = T.Text -> IO () noSettingsChangedCallback :: Maybe SettingsChangedCallback noSettingsChangedCallback = Nothing type SettingsChangedCallbackC = Ptr () -> -- object CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkSettingsChangedCallback :: SettingsChangedCallbackC -> IO (FunPtr SettingsChangedCallbackC) settingsChangedClosure :: SettingsChangedCallback -> IO Closure settingsChangedClosure cb = newCClosure =<< mkSettingsChangedCallback wrapped where wrapped = settingsChangedCallbackWrapper cb settingsChangedCallbackWrapper :: SettingsChangedCallback -> Ptr () -> CString -> Ptr () -> IO () settingsChangedCallbackWrapper _cb _ key _ = do key' <- cstringToText key _cb key' onSettingsChanged :: (GObject a, MonadIO m) => a -> SettingsChangedCallback -> m SignalHandlerId onSettingsChanged obj cb = liftIO $ connectSettingsChanged obj cb SignalConnectBefore afterSettingsChanged :: (GObject a, MonadIO m) => a -> SettingsChangedCallback -> m SignalHandlerId afterSettingsChanged obj cb = connectSettingsChanged obj cb SignalConnectAfter connectSettingsChanged :: (GObject a, MonadIO m) => a -> SettingsChangedCallback -> SignalConnectMode -> m SignalHandlerId connectSettingsChanged obj cb after = liftIO $ do cb' <- mkSettingsChangedCallback (settingsChangedCallbackWrapper cb) connectSignalFunPtr obj "changed" cb' after -- signal Settings::writable-change-event type SettingsWritableChangeEventCallback = Word32 -> IO Bool noSettingsWritableChangeEventCallback :: Maybe SettingsWritableChangeEventCallback noSettingsWritableChangeEventCallback = Nothing type SettingsWritableChangeEventCallbackC = Ptr () -> -- object Word32 -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkSettingsWritableChangeEventCallback :: SettingsWritableChangeEventCallbackC -> IO (FunPtr SettingsWritableChangeEventCallbackC) settingsWritableChangeEventClosure :: SettingsWritableChangeEventCallback -> IO Closure settingsWritableChangeEventClosure cb = newCClosure =<< mkSettingsWritableChangeEventCallback wrapped where wrapped = settingsWritableChangeEventCallbackWrapper cb settingsWritableChangeEventCallbackWrapper :: SettingsWritableChangeEventCallback -> Ptr () -> Word32 -> Ptr () -> IO CInt settingsWritableChangeEventCallbackWrapper _cb _ key _ = do result <- _cb key let result' = (fromIntegral . fromEnum) result return result' onSettingsWritableChangeEvent :: (GObject a, MonadIO m) => a -> SettingsWritableChangeEventCallback -> m SignalHandlerId onSettingsWritableChangeEvent obj cb = liftIO $ connectSettingsWritableChangeEvent obj cb SignalConnectBefore afterSettingsWritableChangeEvent :: (GObject a, MonadIO m) => a -> SettingsWritableChangeEventCallback -> m SignalHandlerId afterSettingsWritableChangeEvent obj cb = connectSettingsWritableChangeEvent obj cb SignalConnectAfter connectSettingsWritableChangeEvent :: (GObject a, MonadIO m) => a -> SettingsWritableChangeEventCallback -> SignalConnectMode -> m SignalHandlerId connectSettingsWritableChangeEvent obj cb after = liftIO $ do cb' <- mkSettingsWritableChangeEventCallback (settingsWritableChangeEventCallbackWrapper cb) connectSignalFunPtr obj "writable-change-event" cb' after -- signal Settings::writable-changed type SettingsWritableChangedCallback = T.Text -> IO () noSettingsWritableChangedCallback :: Maybe SettingsWritableChangedCallback noSettingsWritableChangedCallback = Nothing type SettingsWritableChangedCallbackC = Ptr () -> -- object CString -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkSettingsWritableChangedCallback :: SettingsWritableChangedCallbackC -> IO (FunPtr SettingsWritableChangedCallbackC) settingsWritableChangedClosure :: SettingsWritableChangedCallback -> IO Closure settingsWritableChangedClosure cb = newCClosure =<< mkSettingsWritableChangedCallback wrapped where wrapped = settingsWritableChangedCallbackWrapper cb settingsWritableChangedCallbackWrapper :: SettingsWritableChangedCallback -> Ptr () -> CString -> Ptr () -> IO () settingsWritableChangedCallbackWrapper _cb _ key _ = do key' <- cstringToText key _cb key' onSettingsWritableChanged :: (GObject a, MonadIO m) => a -> SettingsWritableChangedCallback -> m SignalHandlerId onSettingsWritableChanged obj cb = liftIO $ connectSettingsWritableChanged obj cb SignalConnectBefore afterSettingsWritableChanged :: (GObject a, MonadIO m) => a -> SettingsWritableChangedCallback -> m SignalHandlerId afterSettingsWritableChanged obj cb = connectSettingsWritableChanged obj cb SignalConnectAfter connectSettingsWritableChanged :: (GObject a, MonadIO m) => a -> SettingsWritableChangedCallback -> SignalConnectMode -> m SignalHandlerId connectSettingsWritableChanged obj cb after = liftIO $ do cb' <- mkSettingsWritableChangedCallback (settingsWritableChangedCallbackWrapper cb) connectSignalFunPtr obj "writable-changed" cb' after -- struct SettingsBackend newtype SettingsBackend = SettingsBackend (ForeignPtr SettingsBackend) noSettingsBackend :: Maybe SettingsBackend noSettingsBackend = Nothing -- Flags SettingsBindFlags data SettingsBindFlags = SettingsBindFlagsDefault | SettingsBindFlagsGet | SettingsBindFlagsSet | SettingsBindFlagsNoSensitivity | SettingsBindFlagsGetNoChanges | SettingsBindFlagsInvertBoolean | AnotherSettingsBindFlags Int deriving (Show, Eq) instance Enum SettingsBindFlags where fromEnum SettingsBindFlagsDefault = 0 fromEnum SettingsBindFlagsGet = 1 fromEnum SettingsBindFlagsSet = 2 fromEnum SettingsBindFlagsNoSensitivity = 4 fromEnum SettingsBindFlagsGetNoChanges = 8 fromEnum SettingsBindFlagsInvertBoolean = 16 fromEnum (AnotherSettingsBindFlags k) = k toEnum 0 = SettingsBindFlagsDefault toEnum 1 = SettingsBindFlagsGet toEnum 2 = SettingsBindFlagsSet toEnum 4 = SettingsBindFlagsNoSensitivity toEnum 8 = SettingsBindFlagsGetNoChanges toEnum 16 = SettingsBindFlagsInvertBoolean toEnum k = AnotherSettingsBindFlags k foreign import ccall "g_settings_bind_flags_get_type" c_g_settings_bind_flags_get_type :: IO GType instance BoxedEnum SettingsBindFlags where boxedEnumType _ = c_g_settings_bind_flags_get_type instance IsGFlag SettingsBindFlags -- callback SettingsBindGetMapping settingsBindGetMappingClosure :: SettingsBindGetMapping -> IO Closure settingsBindGetMappingClosure cb = newCClosure =<< mkSettingsBindGetMapping wrapped where wrapped = settingsBindGetMappingWrapper Nothing cb type SettingsBindGetMappingC = Ptr GValue -> Ptr GVariant -> Ptr () -> IO CInt foreign import ccall "wrapper" mkSettingsBindGetMapping :: SettingsBindGetMappingC -> IO (FunPtr SettingsBindGetMappingC) type SettingsBindGetMapping = GValue -> GVariant -> IO Bool noSettingsBindGetMapping :: Maybe SettingsBindGetMapping noSettingsBindGetMapping = Nothing settingsBindGetMappingWrapper :: Maybe (Ptr (FunPtr (SettingsBindGetMappingC))) -> SettingsBindGetMapping -> Ptr GValue -> Ptr GVariant -> Ptr () -> IO CInt settingsBindGetMappingWrapper funptrptr _cb value variant _ = do value' <- (newBoxed GValue) value variant' <- newGVariantFromPtr variant result <- _cb value' variant' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback SettingsBindSetMapping settingsBindSetMappingClosure :: SettingsBindSetMapping -> IO Closure settingsBindSetMappingClosure cb = newCClosure =<< mkSettingsBindSetMapping wrapped where wrapped = settingsBindSetMappingWrapper Nothing cb type SettingsBindSetMappingC = Ptr GValue -> Ptr GLib.VariantType -> Ptr () -> IO (Ptr GVariant) foreign import ccall "wrapper" mkSettingsBindSetMapping :: SettingsBindSetMappingC -> IO (FunPtr SettingsBindSetMappingC) type SettingsBindSetMapping = GValue -> GLib.VariantType -> IO GVariant noSettingsBindSetMapping :: Maybe SettingsBindSetMapping noSettingsBindSetMapping = Nothing settingsBindSetMappingWrapper :: Maybe (Ptr (FunPtr (SettingsBindSetMappingC))) -> SettingsBindSetMapping -> Ptr GValue -> Ptr GLib.VariantType -> Ptr () -> IO (Ptr GVariant) settingsBindSetMappingWrapper funptrptr _cb value expected_type _ = do value' <- (newBoxed GValue) value expected_type' <- (newBoxed GLib.VariantType) expected_type result <- _cb value' expected_type' maybeReleaseFunPtr funptrptr result' <- refGVariant result return result' -- callback SettingsGetMapping settingsGetMappingClosure :: SettingsGetMapping -> IO Closure settingsGetMappingClosure cb = newCClosure =<< mkSettingsGetMapping wrapped where wrapped = settingsGetMappingWrapper Nothing cb type SettingsGetMappingC = Ptr GVariant -> Ptr (Ptr ()) -> Ptr () -> IO CInt foreign import ccall "wrapper" mkSettingsGetMapping :: SettingsGetMappingC -> IO (FunPtr SettingsGetMappingC) type SettingsGetMapping = GVariant -> IO (Bool,(Ptr ())) noSettingsGetMapping :: Maybe SettingsGetMapping noSettingsGetMapping = Nothing settingsGetMappingWrapper :: Maybe (Ptr (FunPtr (SettingsGetMappingC))) -> SettingsGetMapping -> Ptr GVariant -> Ptr (Ptr ()) -> Ptr () -> IO CInt settingsGetMappingWrapper funptrptr _cb value result_ _ = do value' <- newGVariantFromPtr value (result, outresult_) <- _cb value' poke result_ outresult_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- struct SettingsSchema newtype SettingsSchema = SettingsSchema (ForeignPtr SettingsSchema) noSettingsSchema :: Maybe SettingsSchema noSettingsSchema = Nothing foreign import ccall "g_settings_schema_get_type" c_g_settings_schema_get_type :: IO GType instance BoxedObject SettingsSchema where boxedType _ = c_g_settings_schema_get_type -- method SettingsSchema::get_id -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_get_id" g_settings_schema_get_id :: Ptr SettingsSchema -> -- _obj : TInterface "Gio" "SettingsSchema" IO CString settingsSchemaGetId :: (MonadIO m) => SettingsSchema -> -- _obj m T.Text settingsSchemaGetId _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_get_id _obj' checkUnexpectedReturnNULL "g_settings_schema_get_id" result result' <- cstringToText result touchManagedPtr _obj return result' -- method SettingsSchema::get_key -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", 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 "Gio" "SettingsSchema", 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 : TInterface "Gio" "SettingsSchemaKey" -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_get_key" g_settings_schema_get_key :: Ptr SettingsSchema -> -- _obj : TInterface "Gio" "SettingsSchema" CString -> -- name : TBasicType TUTF8 IO (Ptr SettingsSchemaKey) settingsSchemaGetKey :: (MonadIO m) => SettingsSchema -> -- _obj T.Text -> -- name m SettingsSchemaKey settingsSchemaGetKey _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_settings_schema_get_key _obj' name' checkUnexpectedReturnNULL "g_settings_schema_get_key" result result' <- (wrapBoxed SettingsSchemaKey) result touchManagedPtr _obj freeMem name' return result' -- method SettingsSchema::get_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_get_path" g_settings_schema_get_path :: Ptr SettingsSchema -> -- _obj : TInterface "Gio" "SettingsSchema" IO CString settingsSchemaGetPath :: (MonadIO m) => SettingsSchema -> -- _obj m T.Text settingsSchemaGetPath _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_get_path _obj' checkUnexpectedReturnNULL "g_settings_schema_get_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method SettingsSchema::has_key -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", 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 "Gio" "SettingsSchema", 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_settings_schema_has_key" g_settings_schema_has_key :: Ptr SettingsSchema -> -- _obj : TInterface "Gio" "SettingsSchema" CString -> -- name : TBasicType TUTF8 IO CInt settingsSchemaHasKey :: (MonadIO m) => SettingsSchema -> -- _obj T.Text -> -- name m Bool settingsSchemaHasKey _obj name = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj name' <- textToCString name result <- g_settings_schema_has_key _obj' name' let result' = (/= 0) result touchManagedPtr _obj freeMem name' return result' -- method SettingsSchema::list_children -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", 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_settings_schema_list_children" g_settings_schema_list_children :: Ptr SettingsSchema -> -- _obj : TInterface "Gio" "SettingsSchema" IO (Ptr CString) settingsSchemaListChildren :: (MonadIO m) => SettingsSchema -> -- _obj m [T.Text] settingsSchemaListChildren _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_list_children _obj' checkUnexpectedReturnNULL "g_settings_schema_list_children" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method SettingsSchema::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SettingsSchema" -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_ref" g_settings_schema_ref :: Ptr SettingsSchema -> -- _obj : TInterface "Gio" "SettingsSchema" IO (Ptr SettingsSchema) settingsSchemaRef :: (MonadIO m) => SettingsSchema -> -- _obj m SettingsSchema settingsSchemaRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_ref _obj' checkUnexpectedReturnNULL "g_settings_schema_ref" result result' <- (wrapBoxed SettingsSchema) result touchManagedPtr _obj return result' -- method SettingsSchema::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchema", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_unref" g_settings_schema_unref :: Ptr SettingsSchema -> -- _obj : TInterface "Gio" "SettingsSchema" IO () settingsSchemaUnref :: (MonadIO m) => SettingsSchema -> -- _obj m () settingsSchemaUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_settings_schema_unref _obj' touchManagedPtr _obj return () -- struct SettingsSchemaKey newtype SettingsSchemaKey = SettingsSchemaKey (ForeignPtr SettingsSchemaKey) noSettingsSchemaKey :: Maybe SettingsSchemaKey noSettingsSchemaKey = Nothing foreign import ccall "g_settings_schema_key_get_type" c_g_settings_schema_key_get_type :: IO GType instance BoxedObject SettingsSchemaKey where boxedType _ = c_g_settings_schema_key_get_type -- method SettingsSchemaKey::get_default_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_key_get_default_value" g_settings_schema_key_get_default_value :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" IO (Ptr GVariant) settingsSchemaKeyGetDefaultValue :: (MonadIO m) => SettingsSchemaKey -> -- _obj m GVariant settingsSchemaKeyGetDefaultValue _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_key_get_default_value _obj' checkUnexpectedReturnNULL "g_settings_schema_key_get_default_value" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method SettingsSchemaKey::get_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_key_get_description" g_settings_schema_key_get_description :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" IO CString settingsSchemaKeyGetDescription :: (MonadIO m) => SettingsSchemaKey -> -- _obj m T.Text settingsSchemaKeyGetDescription _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_key_get_description _obj' checkUnexpectedReturnNULL "g_settings_schema_key_get_description" result result' <- cstringToText result touchManagedPtr _obj return result' -- method SettingsSchemaKey::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_key_get_name" g_settings_schema_key_get_name :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" IO CString settingsSchemaKeyGetName :: (MonadIO m) => SettingsSchemaKey -> -- _obj m T.Text settingsSchemaKeyGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_key_get_name _obj' checkUnexpectedReturnNULL "g_settings_schema_key_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method SettingsSchemaKey::get_range -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TVariant -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_key_get_range" g_settings_schema_key_get_range :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" IO (Ptr GVariant) settingsSchemaKeyGetRange :: (MonadIO m) => SettingsSchemaKey -> -- _obj m GVariant settingsSchemaKeyGetRange _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_key_get_range _obj' checkUnexpectedReturnNULL "g_settings_schema_key_get_range" result result' <- wrapGVariantPtr result touchManagedPtr _obj return result' -- method SettingsSchemaKey::get_summary -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_key_get_summary" g_settings_schema_key_get_summary :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" IO CString settingsSchemaKeyGetSummary :: (MonadIO m) => SettingsSchemaKey -> -- _obj m T.Text settingsSchemaKeyGetSummary _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_key_get_summary _obj' checkUnexpectedReturnNULL "g_settings_schema_key_get_summary" result result' <- cstringToText result touchManagedPtr _obj return result' -- method SettingsSchemaKey::get_value_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", 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_settings_schema_key_get_value_type" g_settings_schema_key_get_value_type :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" IO (Ptr GLib.VariantType) settingsSchemaKeyGetValueType :: (MonadIO m) => SettingsSchemaKey -> -- _obj m GLib.VariantType settingsSchemaKeyGetValueType _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_key_get_value_type _obj' checkUnexpectedReturnNULL "g_settings_schema_key_get_value_type" result result' <- (newBoxed GLib.VariantType) result touchManagedPtr _obj return result' -- method SettingsSchemaKey::range_check -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", 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 "Gio" "SettingsSchemaKey", 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 TBoolean -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_key_range_check" g_settings_schema_key_range_check :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" Ptr GVariant -> -- value : TVariant IO CInt settingsSchemaKeyRangeCheck :: (MonadIO m) => SettingsSchemaKey -> -- _obj GVariant -> -- value m Bool settingsSchemaKeyRangeCheck _obj value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let value' = unsafeManagedPtrGetPtr value result <- g_settings_schema_key_range_check _obj' value' let result' = (/= 0) result touchManagedPtr _obj return result' -- method SettingsSchemaKey::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SettingsSchemaKey" -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_key_ref" g_settings_schema_key_ref :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" IO (Ptr SettingsSchemaKey) settingsSchemaKeyRef :: (MonadIO m) => SettingsSchemaKey -> -- _obj m SettingsSchemaKey settingsSchemaKeyRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_key_ref _obj' checkUnexpectedReturnNULL "g_settings_schema_key_ref" result result' <- (wrapBoxed SettingsSchemaKey) result touchManagedPtr _obj return result' -- method SettingsSchemaKey::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaKey", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_key_unref" g_settings_schema_key_unref :: Ptr SettingsSchemaKey -> -- _obj : TInterface "Gio" "SettingsSchemaKey" IO () settingsSchemaKeyUnref :: (MonadIO m) => SettingsSchemaKey -> -- _obj m () settingsSchemaKeyUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_settings_schema_key_unref _obj' touchManagedPtr _obj return () -- struct SettingsSchemaSource newtype SettingsSchemaSource = SettingsSchemaSource (ForeignPtr SettingsSchemaSource) noSettingsSchemaSource :: Maybe SettingsSchemaSource noSettingsSchemaSource = Nothing foreign import ccall "g_settings_schema_source_get_type" c_g_settings_schema_source_get_type :: IO GType instance BoxedObject SettingsSchemaSource where boxedType _ = c_g_settings_schema_source_get_type -- method SettingsSchemaSource::new_from_directory -- method type : Constructor -- Args : [Arg {argName = "directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trusted", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trusted", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SettingsSchemaSource" -- throws : True -- Skip return : False foreign import ccall "g_settings_schema_source_new_from_directory" g_settings_schema_source_new_from_directory :: CString -> -- directory : TBasicType TUTF8 Ptr SettingsSchemaSource -> -- parent : TInterface "Gio" "SettingsSchemaSource" CInt -> -- trusted : TBasicType TBoolean Ptr (Ptr GError) -> -- error IO (Ptr SettingsSchemaSource) settingsSchemaSourceNewFromDirectory :: (MonadIO m) => T.Text -> -- directory Maybe (SettingsSchemaSource) -> -- parent Bool -> -- trusted m SettingsSchemaSource settingsSchemaSourceNewFromDirectory directory parent trusted = liftIO $ do directory' <- textToCString directory maybeParent <- case parent of Nothing -> return nullPtr Just jParent -> do let jParent' = unsafeManagedPtrGetPtr jParent return jParent' let trusted' = (fromIntegral . fromEnum) trusted onException (do result <- propagateGError $ g_settings_schema_source_new_from_directory directory' maybeParent trusted' checkUnexpectedReturnNULL "g_settings_schema_source_new_from_directory" result result' <- (wrapBoxed SettingsSchemaSource) result whenJust parent touchManagedPtr freeMem directory' return result' ) (do freeMem directory' ) -- method SettingsSchemaSource::list_schemas -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "recursive", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "non_relocatable", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "relocatable", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "recursive", 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_settings_schema_source_list_schemas" g_settings_schema_source_list_schemas :: Ptr SettingsSchemaSource -> -- _obj : TInterface "Gio" "SettingsSchemaSource" CInt -> -- recursive : TBasicType TBoolean Ptr (Ptr CString) -> -- non_relocatable : TCArray True (-1) (-1) (TBasicType TUTF8) Ptr (Ptr CString) -> -- relocatable : TCArray True (-1) (-1) (TBasicType TUTF8) IO () settingsSchemaSourceListSchemas :: (MonadIO m) => SettingsSchemaSource -> -- _obj Bool -> -- recursive m ([T.Text],[T.Text]) settingsSchemaSourceListSchemas _obj recursive = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let recursive' = (fromIntegral . fromEnum) recursive non_relocatable <- allocMem :: IO (Ptr (Ptr CString)) relocatable <- allocMem :: IO (Ptr (Ptr CString)) g_settings_schema_source_list_schemas _obj' recursive' non_relocatable relocatable non_relocatable' <- peek non_relocatable non_relocatable'' <- unpackZeroTerminatedUTF8CArray non_relocatable' mapZeroTerminatedCArray freeMem non_relocatable' freeMem non_relocatable' relocatable' <- peek relocatable relocatable'' <- unpackZeroTerminatedUTF8CArray relocatable' mapZeroTerminatedCArray freeMem relocatable' freeMem relocatable' touchManagedPtr _obj freeMem non_relocatable freeMem relocatable return (non_relocatable'', relocatable'') -- method SettingsSchemaSource::lookup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "recursive", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "schema_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "recursive", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SettingsSchema" -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_source_lookup" g_settings_schema_source_lookup :: Ptr SettingsSchemaSource -> -- _obj : TInterface "Gio" "SettingsSchemaSource" CString -> -- schema_id : TBasicType TUTF8 CInt -> -- recursive : TBasicType TBoolean IO (Ptr SettingsSchema) settingsSchemaSourceLookup :: (MonadIO m) => SettingsSchemaSource -> -- _obj T.Text -> -- schema_id Bool -> -- recursive m SettingsSchema settingsSchemaSourceLookup _obj schema_id recursive = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj schema_id' <- textToCString schema_id let recursive' = (fromIntegral . fromEnum) recursive result <- g_settings_schema_source_lookup _obj' schema_id' recursive' checkUnexpectedReturnNULL "g_settings_schema_source_lookup" result result' <- (wrapBoxed SettingsSchema) result touchManagedPtr _obj freeMem schema_id' return result' -- method SettingsSchemaSource::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SettingsSchemaSource" -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_source_ref" g_settings_schema_source_ref :: Ptr SettingsSchemaSource -> -- _obj : TInterface "Gio" "SettingsSchemaSource" IO (Ptr SettingsSchemaSource) settingsSchemaSourceRef :: (MonadIO m) => SettingsSchemaSource -> -- _obj m SettingsSchemaSource settingsSchemaSourceRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_settings_schema_source_ref _obj' checkUnexpectedReturnNULL "g_settings_schema_source_ref" result result' <- (wrapBoxed SettingsSchemaSource) result touchManagedPtr _obj return result' -- method SettingsSchemaSource::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SettingsSchemaSource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_source_unref" g_settings_schema_source_unref :: Ptr SettingsSchemaSource -> -- _obj : TInterface "Gio" "SettingsSchemaSource" IO () settingsSchemaSourceUnref :: (MonadIO m) => SettingsSchemaSource -> -- _obj m () settingsSchemaSourceUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_settings_schema_source_unref _obj' touchManagedPtr _obj return () -- object SimpleAction newtype SimpleAction = SimpleAction (ForeignPtr SimpleAction) noSimpleAction :: Maybe SimpleAction noSimpleAction = Nothing foreign import ccall "g_simple_action_get_type" c_g_simple_action_get_type :: IO GType type instance ParentTypes SimpleAction = '[GObject.Object, Action] instance GObject SimpleAction where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_simple_action_get_type class GObject o => SimpleActionK o instance (GObject o, IsDescendantOf SimpleAction o) => SimpleActionK o toSimpleAction :: SimpleActionK o => o -> IO SimpleAction toSimpleAction = unsafeCastTo SimpleAction -- method SimpleAction::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 = "parameter_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, 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 = "parameter_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SimpleAction" -- throws : False -- Skip return : False foreign import ccall "g_simple_action_new" g_simple_action_new :: CString -> -- name : TBasicType TUTF8 Ptr GLib.VariantType -> -- parameter_type : TInterface "GLib" "VariantType" IO (Ptr SimpleAction) simpleActionNew :: (MonadIO m) => T.Text -> -- name Maybe (GLib.VariantType) -> -- parameter_type m SimpleAction simpleActionNew name parameter_type = liftIO $ do name' <- textToCString name maybeParameter_type <- case parameter_type of Nothing -> return nullPtr Just jParameter_type -> do let jParameter_type' = unsafeManagedPtrGetPtr jParameter_type return jParameter_type' result <- g_simple_action_new name' maybeParameter_type checkUnexpectedReturnNULL "g_simple_action_new" result result' <- (wrapObject SimpleAction) result whenJust parameter_type touchManagedPtr freeMem name' return result' -- method SimpleAction::new_stateful -- method type : Constructor -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameter_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, 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 = "parameter_type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SimpleAction" -- throws : False -- Skip return : False foreign import ccall "g_simple_action_new_stateful" g_simple_action_new_stateful :: CString -> -- name : TBasicType TUTF8 Ptr GLib.VariantType -> -- parameter_type : TInterface "GLib" "VariantType" Ptr GVariant -> -- state : TVariant IO (Ptr SimpleAction) simpleActionNewStateful :: (MonadIO m) => T.Text -> -- name Maybe (GLib.VariantType) -> -- parameter_type GVariant -> -- state m SimpleAction simpleActionNewStateful name parameter_type state = liftIO $ do name' <- textToCString name maybeParameter_type <- case parameter_type of Nothing -> return nullPtr Just jParameter_type -> do let jParameter_type' = unsafeManagedPtrGetPtr jParameter_type return jParameter_type' let state' = unsafeManagedPtrGetPtr state result <- g_simple_action_new_stateful name' maybeParameter_type state' checkUnexpectedReturnNULL "g_simple_action_new_stateful" result result' <- (wrapObject SimpleAction) result whenJust parameter_type touchManagedPtr freeMem name' return result' -- method SimpleAction::set_enabled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enabled", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "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_simple_action_set_enabled" g_simple_action_set_enabled :: Ptr SimpleAction -> -- _obj : TInterface "Gio" "SimpleAction" CInt -> -- enabled : TBasicType TBoolean IO () simpleActionSetEnabled :: (MonadIO m, SimpleActionK a) => a -> -- _obj Bool -> -- enabled m () simpleActionSetEnabled _obj enabled = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let enabled' = (fromIntegral . fromEnum) enabled g_simple_action_set_enabled _obj' enabled' touchManagedPtr _obj return () -- method SimpleAction::set_state -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAction", 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 "Gio" "SimpleAction", 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_simple_action_set_state" g_simple_action_set_state :: Ptr SimpleAction -> -- _obj : TInterface "Gio" "SimpleAction" Ptr GVariant -> -- value : TVariant IO () simpleActionSetState :: (MonadIO m, SimpleActionK a) => a -> -- _obj GVariant -> -- value m () simpleActionSetState _obj value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let value' = unsafeManagedPtrGetPtr value g_simple_action_set_state _obj' value' touchManagedPtr _obj return () -- method SimpleAction::set_state_hint -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state_hint", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "state_hint", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_simple_action_set_state_hint" g_simple_action_set_state_hint :: Ptr SimpleAction -> -- _obj : TInterface "Gio" "SimpleAction" Ptr GVariant -> -- state_hint : TVariant IO () simpleActionSetStateHint :: (MonadIO m, SimpleActionK a) => a -> -- _obj Maybe (GVariant) -> -- state_hint m () simpleActionSetStateHint _obj state_hint = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeState_hint <- case state_hint of Nothing -> return nullPtr Just jState_hint -> do let jState_hint' = unsafeManagedPtrGetPtr jState_hint return jState_hint' g_simple_action_set_state_hint _obj' maybeState_hint touchManagedPtr _obj return () -- signal SimpleAction::activate type SimpleActionActivateCallback = Maybe GVariant -> IO () noSimpleActionActivateCallback :: Maybe SimpleActionActivateCallback noSimpleActionActivateCallback = Nothing type SimpleActionActivateCallbackC = Ptr () -> -- object Ptr GVariant -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkSimpleActionActivateCallback :: SimpleActionActivateCallbackC -> IO (FunPtr SimpleActionActivateCallbackC) simpleActionActivateClosure :: SimpleActionActivateCallback -> IO Closure simpleActionActivateClosure cb = newCClosure =<< mkSimpleActionActivateCallback wrapped where wrapped = simpleActionActivateCallbackWrapper cb simpleActionActivateCallbackWrapper :: SimpleActionActivateCallback -> Ptr () -> Ptr GVariant -> Ptr () -> IO () simpleActionActivateCallbackWrapper _cb _ parameter _ = do maybeParameter <- if parameter == nullPtr then return Nothing else do parameter' <- newGVariantFromPtr parameter return $ Just parameter' _cb maybeParameter onSimpleActionActivate :: (GObject a, MonadIO m) => a -> SimpleActionActivateCallback -> m SignalHandlerId onSimpleActionActivate obj cb = liftIO $ connectSimpleActionActivate obj cb SignalConnectBefore afterSimpleActionActivate :: (GObject a, MonadIO m) => a -> SimpleActionActivateCallback -> m SignalHandlerId afterSimpleActionActivate obj cb = connectSimpleActionActivate obj cb SignalConnectAfter connectSimpleActionActivate :: (GObject a, MonadIO m) => a -> SimpleActionActivateCallback -> SignalConnectMode -> m SignalHandlerId connectSimpleActionActivate obj cb after = liftIO $ do cb' <- mkSimpleActionActivateCallback (simpleActionActivateCallbackWrapper cb) connectSignalFunPtr obj "activate" cb' after -- signal SimpleAction::change-state type SimpleActionChangeStateCallback = Maybe GVariant -> IO () noSimpleActionChangeStateCallback :: Maybe SimpleActionChangeStateCallback noSimpleActionChangeStateCallback = Nothing type SimpleActionChangeStateCallbackC = Ptr () -> -- object Ptr GVariant -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkSimpleActionChangeStateCallback :: SimpleActionChangeStateCallbackC -> IO (FunPtr SimpleActionChangeStateCallbackC) simpleActionChangeStateClosure :: SimpleActionChangeStateCallback -> IO Closure simpleActionChangeStateClosure cb = newCClosure =<< mkSimpleActionChangeStateCallback wrapped where wrapped = simpleActionChangeStateCallbackWrapper cb simpleActionChangeStateCallbackWrapper :: SimpleActionChangeStateCallback -> Ptr () -> Ptr GVariant -> Ptr () -> IO () simpleActionChangeStateCallbackWrapper _cb _ value _ = do maybeValue <- if value == nullPtr then return Nothing else do value' <- newGVariantFromPtr value return $ Just value' _cb maybeValue onSimpleActionChangeState :: (GObject a, MonadIO m) => a -> SimpleActionChangeStateCallback -> m SignalHandlerId onSimpleActionChangeState obj cb = liftIO $ connectSimpleActionChangeState obj cb SignalConnectBefore afterSimpleActionChangeState :: (GObject a, MonadIO m) => a -> SimpleActionChangeStateCallback -> m SignalHandlerId afterSimpleActionChangeState obj cb = connectSimpleActionChangeState obj cb SignalConnectAfter connectSimpleActionChangeState :: (GObject a, MonadIO m) => a -> SimpleActionChangeStateCallback -> SignalConnectMode -> m SignalHandlerId connectSimpleActionChangeState obj cb after = liftIO $ do cb' <- mkSimpleActionChangeStateCallback (simpleActionChangeStateCallbackWrapper cb) connectSignalFunPtr obj "change-state" cb' after -- object SimpleActionGroup newtype SimpleActionGroup = SimpleActionGroup (ForeignPtr SimpleActionGroup) noSimpleActionGroup :: Maybe SimpleActionGroup noSimpleActionGroup = Nothing foreign import ccall "g_simple_action_group_get_type" c_g_simple_action_group_get_type :: IO GType type instance ParentTypes SimpleActionGroup = '[GObject.Object, ActionGroup, ActionMap] instance GObject SimpleActionGroup where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_simple_action_group_get_type class GObject o => SimpleActionGroupK o instance (GObject o, IsDescendantOf SimpleActionGroup o) => SimpleActionGroupK o toSimpleActionGroup :: SimpleActionGroupK o => o -> IO SimpleActionGroup toSimpleActionGroup = unsafeCastTo SimpleActionGroup -- method SimpleActionGroup::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "SimpleActionGroup" -- throws : False -- Skip return : False foreign import ccall "g_simple_action_group_new" g_simple_action_group_new :: IO (Ptr SimpleActionGroup) simpleActionGroupNew :: (MonadIO m) => m SimpleActionGroup simpleActionGroupNew = liftIO $ do result <- g_simple_action_group_new checkUnexpectedReturnNULL "g_simple_action_group_new" result result' <- (wrapObject SimpleActionGroup) result return result' -- method SimpleActionGroup::add_entries -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TCArray False (-1) 2 (TInterface "Gio" "ActionEntry"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_entries", argType = TBasicType TInt32, 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 : [Arg {argName = "n_entries", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TCArray False (-1) 2 (TInterface "Gio" "ActionEntry"), 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_simple_action_group_add_entries" g_simple_action_group_add_entries :: Ptr SimpleActionGroup -> -- _obj : TInterface "Gio" "SimpleActionGroup" Ptr ActionEntry -> -- entries : TCArray False (-1) 2 (TInterface "Gio" "ActionEntry") Int32 -> -- n_entries : TBasicType TInt32 Ptr () -> -- user_data : TBasicType TVoid IO () {-# DEPRECATED simpleActionGroupAddEntries ["(Since version 2.38)","Use g_action_map_add_action_entries()"]#-} simpleActionGroupAddEntries :: (MonadIO m, SimpleActionGroupK a) => a -> -- _obj [ActionEntry] -> -- entries Ptr () -> -- user_data m () simpleActionGroupAddEntries _obj entries user_data = liftIO $ do let n_entries = fromIntegral $ length entries let _obj' = unsafeManagedPtrCastPtr _obj let entries' = map unsafeManagedPtrGetPtr entries entries'' <- packBlockArray 64 entries' g_simple_action_group_add_entries _obj' entries'' n_entries user_data touchManagedPtr _obj mapM_ touchManagedPtr entries freeMem entries'' return () -- method SimpleActionGroup::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action", argType = TInterface "Gio" "Action", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_simple_action_group_insert" g_simple_action_group_insert :: Ptr SimpleActionGroup -> -- _obj : TInterface "Gio" "SimpleActionGroup" Ptr Action -> -- action : TInterface "Gio" "Action" IO () {-# DEPRECATED simpleActionGroupInsert ["(Since version 2.38)","Use g_action_map_add_action()"]#-} simpleActionGroupInsert :: (MonadIO m, SimpleActionGroupK a, ActionK b) => a -> -- _obj b -> -- action m () simpleActionGroupInsert _obj action = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let action' = unsafeManagedPtrCastPtr action g_simple_action_group_insert _obj' action' touchManagedPtr _obj touchManagedPtr action return () -- method SimpleActionGroup::lookup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Action" -- throws : False -- Skip return : False foreign import ccall "g_simple_action_group_lookup" g_simple_action_group_lookup :: Ptr SimpleActionGroup -> -- _obj : TInterface "Gio" "SimpleActionGroup" CString -> -- action_name : TBasicType TUTF8 IO (Ptr Action) {-# DEPRECATED simpleActionGroupLookup ["(Since version 2.38)","Use g_action_map_lookup_action()"]#-} simpleActionGroupLookup :: (MonadIO m, SimpleActionGroupK a) => a -> -- _obj T.Text -> -- action_name m Action simpleActionGroupLookup _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name result <- g_simple_action_group_lookup _obj' action_name' checkUnexpectedReturnNULL "g_simple_action_group_lookup" result result' <- (newObject Action) result touchManagedPtr _obj freeMem action_name' return result' -- method SimpleActionGroup::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleActionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_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_simple_action_group_remove" g_simple_action_group_remove :: Ptr SimpleActionGroup -> -- _obj : TInterface "Gio" "SimpleActionGroup" CString -> -- action_name : TBasicType TUTF8 IO () {-# DEPRECATED simpleActionGroupRemove ["(Since version 2.38)","Use g_action_map_remove_action()"]#-} simpleActionGroupRemove :: (MonadIO m, SimpleActionGroupK a) => a -> -- _obj T.Text -> -- action_name m () simpleActionGroupRemove _obj action_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj action_name' <- textToCString action_name g_simple_action_group_remove _obj' action_name' touchManagedPtr _obj freeMem action_name' return () -- object SimpleAsyncResult newtype SimpleAsyncResult = SimpleAsyncResult (ForeignPtr SimpleAsyncResult) noSimpleAsyncResult :: Maybe SimpleAsyncResult noSimpleAsyncResult = Nothing foreign import ccall "g_simple_async_result_get_type" c_g_simple_async_result_get_type :: IO GType type instance ParentTypes SimpleAsyncResult = '[GObject.Object, AsyncResult] instance GObject SimpleAsyncResult where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_simple_async_result_get_type class GObject o => SimpleAsyncResultK o instance (GObject o, IsDescendantOf SimpleAsyncResult o) => SimpleAsyncResultK o toSimpleAsyncResult :: SimpleAsyncResultK o => o -> IO SimpleAsyncResult toSimpleAsyncResult = unsafeCastTo SimpleAsyncResult -- method SimpleAsyncResult::new -- method type : Constructor -- Args : [Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 2, 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 = "source_tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SimpleAsyncResult" -- throws : False -- Skip return : False foreign import ccall "g_simple_async_result_new" g_simple_async_result_new :: Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid Ptr () -> -- source_tag : TBasicType TVoid IO (Ptr SimpleAsyncResult) simpleAsyncResultNew :: (MonadIO m, GObject.ObjectK a) => Maybe (a) -> -- source_object Maybe (AsyncReadyCallback) -> -- callback Ptr () -> -- source_tag m SimpleAsyncResult simpleAsyncResultNew source_object callback source_tag = liftIO $ do maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr result <- g_simple_async_result_new maybeSource_object maybeCallback user_data source_tag checkUnexpectedReturnNULL "g_simple_async_result_new" result result' <- (wrapObject SimpleAsyncResult) result whenJust source_object touchManagedPtr return result' -- method SimpleAsyncResult::new_from_error -- method type : Constructor -- Args : [Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 2, 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 = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SimpleAsyncResult" -- throws : False -- Skip return : False foreign import ccall "g_simple_async_result_new_from_error" g_simple_async_result_new_from_error :: Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid Ptr GError -> -- error : TError IO (Ptr SimpleAsyncResult) simpleAsyncResultNewFromError :: (MonadIO m, GObject.ObjectK a) => Maybe (a) -> -- source_object Maybe (AsyncReadyCallback) -> -- callback GError -> -- error m SimpleAsyncResult simpleAsyncResultNewFromError source_object callback error_ = liftIO $ do maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let error_' = unsafeManagedPtrGetPtr error_ let user_data = nullPtr result <- g_simple_async_result_new_from_error maybeSource_object maybeCallback user_data error_' checkUnexpectedReturnNULL "g_simple_async_result_new_from_error" result result' <- (wrapObject SimpleAsyncResult) result whenJust source_object touchManagedPtr touchManagedPtr error_ return result' -- method SimpleAsyncResult::complete -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_simple_async_result_complete" g_simple_async_result_complete :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" IO () simpleAsyncResultComplete :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj m () simpleAsyncResultComplete _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_simple_async_result_complete _obj' touchManagedPtr _obj return () -- method SimpleAsyncResult::complete_in_idle -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_simple_async_result_complete_in_idle" g_simple_async_result_complete_in_idle :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" IO () simpleAsyncResultCompleteInIdle :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj m () simpleAsyncResultCompleteInIdle _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_simple_async_result_complete_in_idle _obj' touchManagedPtr _obj return () -- method SimpleAsyncResult::get_op_res_gboolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_simple_async_result_get_op_res_gboolean" g_simple_async_result_get_op_res_gboolean :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" IO CInt simpleAsyncResultGetOpResGboolean :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj m Bool simpleAsyncResultGetOpResGboolean _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_simple_async_result_get_op_res_gboolean _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method SimpleAsyncResult::get_op_res_gssize -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_simple_async_result_get_op_res_gssize" g_simple_async_result_get_op_res_gssize :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" IO Int64 simpleAsyncResultGetOpResGssize :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj m Int64 simpleAsyncResultGetOpResGssize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_simple_async_result_get_op_res_gssize _obj' touchManagedPtr _obj return result -- method SimpleAsyncResult::propagate_error -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_simple_async_result_propagate_error" g_simple_async_result_propagate_error :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" Ptr (Ptr GError) -> -- error IO CInt simpleAsyncResultPropagateError :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj m () simpleAsyncResultPropagateError _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_simple_async_result_propagate_error _obj' touchManagedPtr _obj return () ) (do return () ) -- method SimpleAsyncResult::set_check_cancellable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "check_cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "check_cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_simple_async_result_set_check_cancellable" g_simple_async_result_set_check_cancellable :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" Ptr Cancellable -> -- check_cancellable : TInterface "Gio" "Cancellable" IO () simpleAsyncResultSetCheckCancellable :: (MonadIO m, SimpleAsyncResultK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- check_cancellable m () simpleAsyncResultSetCheckCancellable _obj check_cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCheck_cancellable <- case check_cancellable of Nothing -> return nullPtr Just jCheck_cancellable -> do let jCheck_cancellable' = unsafeManagedPtrCastPtr jCheck_cancellable return jCheck_cancellable' g_simple_async_result_set_check_cancellable _obj' maybeCheck_cancellable touchManagedPtr _obj whenJust check_cancellable touchManagedPtr return () -- method SimpleAsyncResult::set_from_error -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", 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}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_simple_async_result_set_from_error" g_simple_async_result_set_from_error :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" Ptr GError -> -- error : TError IO () simpleAsyncResultSetFromError :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj GError -> -- error m () simpleAsyncResultSetFromError _obj error_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let error_' = unsafeManagedPtrGetPtr error_ g_simple_async_result_set_from_error _obj' error_' touchManagedPtr _obj touchManagedPtr error_ return () -- method SimpleAsyncResult::set_handle_cancellation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handle_cancellation", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handle_cancellation", 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_simple_async_result_set_handle_cancellation" g_simple_async_result_set_handle_cancellation :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" CInt -> -- handle_cancellation : TBasicType TBoolean IO () simpleAsyncResultSetHandleCancellation :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj Bool -> -- handle_cancellation m () simpleAsyncResultSetHandleCancellation _obj handle_cancellation = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let handle_cancellation' = (fromIntegral . fromEnum) handle_cancellation g_simple_async_result_set_handle_cancellation _obj' handle_cancellation' touchManagedPtr _obj return () -- method SimpleAsyncResult::set_op_res_gboolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "op_res", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "op_res", 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_simple_async_result_set_op_res_gboolean" g_simple_async_result_set_op_res_gboolean :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" CInt -> -- op_res : TBasicType TBoolean IO () simpleAsyncResultSetOpResGboolean :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj Bool -> -- op_res m () simpleAsyncResultSetOpResGboolean _obj op_res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let op_res' = (fromIntegral . fromEnum) op_res g_simple_async_result_set_op_res_gboolean _obj' op_res' touchManagedPtr _obj return () -- method SimpleAsyncResult::set_op_res_gssize -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "op_res", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleAsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "op_res", 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_simple_async_result_set_op_res_gssize" g_simple_async_result_set_op_res_gssize :: Ptr SimpleAsyncResult -> -- _obj : TInterface "Gio" "SimpleAsyncResult" Int64 -> -- op_res : TBasicType TInt64 IO () simpleAsyncResultSetOpResGssize :: (MonadIO m, SimpleAsyncResultK a) => a -> -- _obj Int64 -> -- op_res m () simpleAsyncResultSetOpResGssize _obj op_res = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_simple_async_result_set_op_res_gssize _obj' op_res touchManagedPtr _obj return () -- method SimpleAsyncResult::is_valid -- method type : MemberFunction -- Args : [Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_tag", 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_simple_async_result_is_valid" g_simple_async_result_is_valid :: Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr GObject.Object -> -- source : TInterface "GObject" "Object" Ptr () -> -- source_tag : TBasicType TVoid IO CInt simpleAsyncResultIsValid :: (MonadIO m, AsyncResultK a, GObject.ObjectK b) => a -> -- result Maybe (b) -> -- source Maybe (Ptr ()) -> -- source_tag m Bool simpleAsyncResultIsValid result_ source source_tag = liftIO $ do let result_' = unsafeManagedPtrCastPtr result_ maybeSource <- case source of Nothing -> return nullPtr Just jSource -> do let jSource' = unsafeManagedPtrCastPtr jSource return jSource' maybeSource_tag <- case source_tag of Nothing -> return nullPtr Just jSource_tag -> do return jSource_tag result <- g_simple_async_result_is_valid result_' maybeSource maybeSource_tag let result' = (/= 0) result touchManagedPtr result_ whenJust source touchManagedPtr return result' -- callback SimpleAsyncThreadFunc simpleAsyncThreadFuncClosure :: SimpleAsyncThreadFunc -> IO Closure simpleAsyncThreadFuncClosure cb = newCClosure =<< mkSimpleAsyncThreadFunc wrapped where wrapped = simpleAsyncThreadFuncWrapper Nothing cb type SimpleAsyncThreadFuncC = Ptr SimpleAsyncResult -> Ptr GObject.Object -> Ptr Cancellable -> IO () foreign import ccall "wrapper" mkSimpleAsyncThreadFunc :: SimpleAsyncThreadFuncC -> IO (FunPtr SimpleAsyncThreadFuncC) type SimpleAsyncThreadFunc = SimpleAsyncResult -> GObject.Object -> Maybe Cancellable -> IO () noSimpleAsyncThreadFunc :: Maybe SimpleAsyncThreadFunc noSimpleAsyncThreadFunc = Nothing simpleAsyncThreadFuncWrapper :: Maybe (Ptr (FunPtr (SimpleAsyncThreadFuncC))) -> SimpleAsyncThreadFunc -> Ptr SimpleAsyncResult -> Ptr GObject.Object -> Ptr Cancellable -> IO () simpleAsyncThreadFuncWrapper funptrptr _cb res object cancellable = do res' <- (newObject SimpleAsyncResult) res object' <- (newObject GObject.Object) object maybeCancellable <- if cancellable == nullPtr then return Nothing else do cancellable' <- (newObject Cancellable) cancellable return $ Just cancellable' _cb res' object' maybeCancellable maybeReleaseFunPtr funptrptr -- object SimpleIOStream newtype SimpleIOStream = SimpleIOStream (ForeignPtr SimpleIOStream) noSimpleIOStream :: Maybe SimpleIOStream noSimpleIOStream = Nothing foreign import ccall "g_simple_io_stream_get_type" c_g_simple_io_stream_get_type :: IO GType type instance ParentTypes SimpleIOStream = '[IOStream, GObject.Object] instance GObject SimpleIOStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_simple_io_stream_get_type class GObject o => SimpleIOStreamK o instance (GObject o, IsDescendantOf SimpleIOStream o) => SimpleIOStreamK o toSimpleIOStream :: SimpleIOStreamK o => o -> IO SimpleIOStream toSimpleIOStream = unsafeCastTo SimpleIOStream -- method SimpleIOStream::new -- method type : Constructor -- Args : [Arg {argName = "input_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "output_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "input_stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "output_stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SimpleIOStream" -- throws : False -- Skip return : False foreign import ccall "g_simple_io_stream_new" g_simple_io_stream_new :: Ptr InputStream -> -- input_stream : TInterface "Gio" "InputStream" Ptr OutputStream -> -- output_stream : TInterface "Gio" "OutputStream" IO (Ptr SimpleIOStream) simpleIOStreamNew :: (MonadIO m, InputStreamK a, OutputStreamK b) => a -> -- input_stream b -> -- output_stream m SimpleIOStream simpleIOStreamNew input_stream output_stream = liftIO $ do let input_stream' = unsafeManagedPtrCastPtr input_stream let output_stream' = unsafeManagedPtrCastPtr output_stream result <- g_simple_io_stream_new input_stream' output_stream' checkUnexpectedReturnNULL "g_simple_io_stream_new" result result' <- (wrapObject SimpleIOStream) result touchManagedPtr input_stream touchManagedPtr output_stream return result' -- object SimplePermission newtype SimplePermission = SimplePermission (ForeignPtr SimplePermission) noSimplePermission :: Maybe SimplePermission noSimplePermission = Nothing foreign import ccall "g_simple_permission_get_type" c_g_simple_permission_get_type :: IO GType type instance ParentTypes SimplePermission = '[Permission, GObject.Object] instance GObject SimplePermission where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_simple_permission_get_type class GObject o => SimplePermissionK o instance (GObject o, IsDescendantOf SimplePermission o) => SimplePermissionK o toSimplePermission :: SimplePermissionK o => o -> IO SimplePermission toSimplePermission = unsafeCastTo SimplePermission -- method SimplePermission::new -- method type : Constructor -- Args : [Arg {argName = "allowed", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "allowed", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SimplePermission" -- throws : False -- Skip return : False foreign import ccall "g_simple_permission_new" g_simple_permission_new :: CInt -> -- allowed : TBasicType TBoolean IO (Ptr SimplePermission) simplePermissionNew :: (MonadIO m) => Bool -> -- allowed m SimplePermission simplePermissionNew allowed = liftIO $ do let allowed' = (fromIntegral . fromEnum) allowed result <- g_simple_permission_new allowed' checkUnexpectedReturnNULL "g_simple_permission_new" result result' <- (wrapObject SimplePermission) result return result' -- object SimpleProxyResolver newtype SimpleProxyResolver = SimpleProxyResolver (ForeignPtr SimpleProxyResolver) noSimpleProxyResolver :: Maybe SimpleProxyResolver noSimpleProxyResolver = Nothing foreign import ccall "g_simple_proxy_resolver_get_type" c_g_simple_proxy_resolver_get_type :: IO GType type instance ParentTypes SimpleProxyResolver = '[GObject.Object, ProxyResolver] instance GObject SimpleProxyResolver where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_simple_proxy_resolver_get_type class GObject o => SimpleProxyResolverK o instance (GObject o, IsDescendantOf SimpleProxyResolver o) => SimpleProxyResolverK o toSimpleProxyResolver :: SimpleProxyResolverK o => o -> IO SimpleProxyResolver toSimpleProxyResolver = unsafeCastTo SimpleProxyResolver -- method SimpleProxyResolver::set_default_proxy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_proxy", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_proxy", 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_simple_proxy_resolver_set_default_proxy" g_simple_proxy_resolver_set_default_proxy :: Ptr SimpleProxyResolver -> -- _obj : TInterface "Gio" "SimpleProxyResolver" CString -> -- default_proxy : TBasicType TUTF8 IO () simpleProxyResolverSetDefaultProxy :: (MonadIO m, SimpleProxyResolverK a) => a -> -- _obj T.Text -> -- default_proxy m () simpleProxyResolverSetDefaultProxy _obj default_proxy = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj default_proxy' <- textToCString default_proxy g_simple_proxy_resolver_set_default_proxy _obj' default_proxy' touchManagedPtr _obj freeMem default_proxy' return () -- method SimpleProxyResolver::set_ignore_hosts -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ignore_hosts", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ignore_hosts", 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_simple_proxy_resolver_set_ignore_hosts" g_simple_proxy_resolver_set_ignore_hosts :: Ptr SimpleProxyResolver -> -- _obj : TInterface "Gio" "SimpleProxyResolver" CString -> -- ignore_hosts : TBasicType TUTF8 IO () simpleProxyResolverSetIgnoreHosts :: (MonadIO m, SimpleProxyResolverK a) => a -> -- _obj T.Text -> -- ignore_hosts m () simpleProxyResolverSetIgnoreHosts _obj ignore_hosts = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj ignore_hosts' <- textToCString ignore_hosts g_simple_proxy_resolver_set_ignore_hosts _obj' ignore_hosts' touchManagedPtr _obj freeMem ignore_hosts' return () -- method SimpleProxyResolver::set_uri_proxy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "proxy", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SimpleProxyResolver", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uri_scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "proxy", 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_simple_proxy_resolver_set_uri_proxy" g_simple_proxy_resolver_set_uri_proxy :: Ptr SimpleProxyResolver -> -- _obj : TInterface "Gio" "SimpleProxyResolver" CString -> -- uri_scheme : TBasicType TUTF8 CString -> -- proxy : TBasicType TUTF8 IO () simpleProxyResolverSetUriProxy :: (MonadIO m, SimpleProxyResolverK a) => a -> -- _obj T.Text -> -- uri_scheme T.Text -> -- proxy m () simpleProxyResolverSetUriProxy _obj uri_scheme proxy = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri_scheme' <- textToCString uri_scheme proxy' <- textToCString proxy g_simple_proxy_resolver_set_uri_proxy _obj' uri_scheme' proxy' touchManagedPtr _obj freeMem uri_scheme' freeMem proxy' return () -- method SimpleProxyResolver::new -- method type : MemberFunction -- Args : [Arg {argName = "default_proxy", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ignore_hosts", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "default_proxy", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ignore_hosts", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ProxyResolver" -- throws : False -- Skip return : False foreign import ccall "g_simple_proxy_resolver_new" g_simple_proxy_resolver_new :: CString -> -- default_proxy : TBasicType TUTF8 CString -> -- ignore_hosts : TBasicType TUTF8 IO (Ptr ProxyResolver) simpleProxyResolverNew :: (MonadIO m) => Maybe (T.Text) -> -- default_proxy Maybe (T.Text) -> -- ignore_hosts m ProxyResolver simpleProxyResolverNew default_proxy ignore_hosts = liftIO $ do maybeDefault_proxy <- case default_proxy of Nothing -> return nullPtr Just jDefault_proxy -> do jDefault_proxy' <- textToCString jDefault_proxy return jDefault_proxy' maybeIgnore_hosts <- case ignore_hosts of Nothing -> return nullPtr Just jIgnore_hosts -> do jIgnore_hosts' <- textToCString jIgnore_hosts return jIgnore_hosts' result <- g_simple_proxy_resolver_new maybeDefault_proxy maybeIgnore_hosts checkUnexpectedReturnNULL "g_simple_proxy_resolver_new" result result' <- (wrapObject ProxyResolver) result freeMem maybeDefault_proxy freeMem maybeIgnore_hosts return result' -- object Socket newtype Socket = Socket (ForeignPtr Socket) noSocket :: Maybe Socket noSocket = Nothing foreign import ccall "g_socket_get_type" c_g_socket_get_type :: IO GType type instance ParentTypes Socket = '[GObject.Object, Initable] instance GObject Socket where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_get_type class GObject o => SocketK o instance (GObject o, IsDescendantOf Socket o) => SocketK o toSocket :: SocketK o => o -> IO Socket toSocket = unsafeCastTo Socket -- method Socket::new -- method type : Constructor -- Args : [Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TInterface "Gio" "SocketProtocol", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TInterface "Gio" "SocketProtocol", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Socket" -- throws : True -- Skip return : False foreign import ccall "g_socket_new" g_socket_new :: CUInt -> -- family : TInterface "Gio" "SocketFamily" CUInt -> -- type : TInterface "Gio" "SocketType" CUInt -> -- protocol : TInterface "Gio" "SocketProtocol" Ptr (Ptr GError) -> -- error IO (Ptr Socket) socketNew :: (MonadIO m) => SocketFamily -> -- family SocketType -> -- type SocketProtocol -> -- protocol m Socket socketNew family type_ protocol = liftIO $ do let family' = (fromIntegral . fromEnum) family let type_' = (fromIntegral . fromEnum) type_ let protocol' = (fromIntegral . fromEnum) protocol onException (do result <- propagateGError $ g_socket_new family' type_' protocol' checkUnexpectedReturnNULL "g_socket_new" result result' <- (wrapObject Socket) result return result' ) (do return () ) -- method Socket::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}] -- Lengths : [] -- hInArgs : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Socket" -- throws : True -- Skip return : False foreign import ccall "g_socket_new_from_fd" g_socket_new_from_fd :: Int32 -> -- fd : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO (Ptr Socket) socketNewFromFd :: (MonadIO m) => Int32 -> -- fd m Socket socketNewFromFd fd = liftIO $ do onException (do result <- propagateGError $ g_socket_new_from_fd fd checkUnexpectedReturnNULL "g_socket_new_from_fd" result result' <- (wrapObject Socket) result return result' ) (do return () ) -- method Socket::accept -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Socket" -- throws : True -- Skip return : False foreign import ccall "g_socket_accept" g_socket_accept :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr Socket) socketAccept :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Socket socketAccept _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_accept _obj' maybeCancellable checkUnexpectedReturnNULL "g_socket_accept" result result' <- (wrapObject Socket) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method Socket::bind -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_reuse", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_reuse", 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_socket_bind" g_socket_bind :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr SocketAddress -> -- address : TInterface "Gio" "SocketAddress" CInt -> -- allow_reuse : TBasicType TBoolean Ptr (Ptr GError) -> -- error IO CInt socketBind :: (MonadIO m, SocketK a, SocketAddressK b) => a -> -- _obj b -> -- address Bool -> -- allow_reuse m () socketBind _obj address allow_reuse = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let address' = unsafeManagedPtrCastPtr address let allow_reuse' = (fromIntegral . fromEnum) allow_reuse onException (do _ <- propagateGError $ g_socket_bind _obj' address' allow_reuse' touchManagedPtr _obj touchManagedPtr address return () ) (do return () ) -- method Socket::check_connect_result -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_check_connect_result" g_socket_check_connect_result :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr (Ptr GError) -> -- error IO CInt socketCheckConnectResult :: (MonadIO m, SocketK a) => a -> -- _obj m () socketCheckConnectResult _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_socket_check_connect_result _obj' touchManagedPtr _obj return () ) (do return () ) -- method Socket::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_close" g_socket_close :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr (Ptr GError) -> -- error IO CInt socketClose :: (MonadIO m, SocketK a) => a -> -- _obj m () socketClose _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_socket_close _obj' touchManagedPtr _obj return () ) (do return () ) -- method Socket::condition_check -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", 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 = "_obj", argType = TInterface "Gio" "Socket", 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" "IOCondition" -- throws : False -- Skip return : False foreign import ccall "g_socket_condition_check" g_socket_condition_check :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" CUInt -> -- condition : TInterface "GLib" "IOCondition" IO CUInt socketConditionCheck :: (MonadIO m, SocketK a) => a -> -- _obj [GLib.IOCondition] -> -- condition m [GLib.IOCondition] socketConditionCheck _obj condition = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let condition' = gflagsToWord condition result <- g_socket_condition_check _obj' condition' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method Socket::condition_timed_wait -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", 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 = "timeout", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", 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 = "timeout", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_condition_timed_wait" g_socket_condition_timed_wait :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" CUInt -> -- condition : TInterface "GLib" "IOCondition" Int64 -> -- timeout : TBasicType TInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt socketConditionTimedWait :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj [GLib.IOCondition] -> -- condition Int64 -> -- timeout Maybe (b) -> -- cancellable m () socketConditionTimedWait _obj condition timeout cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let condition' = gflagsToWord condition maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_socket_condition_timed_wait _obj' condition' timeout maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Socket::condition_wait -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_condition_wait" g_socket_condition_wait :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" CUInt -> -- condition : TInterface "GLib" "IOCondition" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt socketConditionWait :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj [GLib.IOCondition] -> -- condition Maybe (b) -> -- cancellable m () socketConditionWait _obj condition cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let condition' = gflagsToWord condition maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_socket_condition_wait _obj' condition' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Socket::connect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_connect" g_socket_connect :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr SocketAddress -> -- address : TInterface "Gio" "SocketAddress" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt socketConnect :: (MonadIO m, SocketK a, SocketAddressK b, CancellableK c) => a -> -- _obj b -> -- address Maybe (c) -> -- cancellable m () socketConnect _obj address cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let address' = unsafeManagedPtrCastPtr address maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_socket_connect _obj' address' maybeCancellable touchManagedPtr _obj touchManagedPtr address whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Socket::connection_factory_create_connection -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : False -- Skip return : False foreign import ccall "g_socket_connection_factory_create_connection" g_socket_connection_factory_create_connection :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO (Ptr SocketConnection) socketConnectionFactoryCreateConnection :: (MonadIO m, SocketK a) => a -> -- _obj m SocketConnection socketConnectionFactoryCreateConnection _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_connection_factory_create_connection _obj' checkUnexpectedReturnNULL "g_socket_connection_factory_create_connection" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj return result' -- method Socket::get_available_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_socket_get_available_bytes" g_socket_get_available_bytes :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO Int64 socketGetAvailableBytes :: (MonadIO m, SocketK a) => a -> -- _obj m Int64 socketGetAvailableBytes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_available_bytes _obj' touchManagedPtr _obj return result -- method Socket::get_blocking -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_get_blocking" g_socket_get_blocking :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CInt socketGetBlocking :: (MonadIO m, SocketK a) => a -> -- _obj m Bool socketGetBlocking _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_blocking _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Socket::get_broadcast -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_get_broadcast" g_socket_get_broadcast :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CInt socketGetBroadcast :: (MonadIO m, SocketK a) => a -> -- _obj m Bool socketGetBroadcast _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_broadcast _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Socket::get_credentials -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Credentials" -- throws : True -- Skip return : False foreign import ccall "g_socket_get_credentials" g_socket_get_credentials :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr (Ptr GError) -> -- error IO (Ptr Credentials) socketGetCredentials :: (MonadIO m, SocketK a) => a -> -- _obj m Credentials socketGetCredentials _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_socket_get_credentials _obj' checkUnexpectedReturnNULL "g_socket_get_credentials" result result' <- (wrapObject Credentials) result touchManagedPtr _obj return result' ) (do return () ) -- method Socket::get_family -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketFamily" -- throws : False -- Skip return : False foreign import ccall "g_socket_get_family" g_socket_get_family :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CUInt socketGetFamily :: (MonadIO m, SocketK a) => a -> -- _obj m SocketFamily socketGetFamily _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_family _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Socket::get_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_socket_get_fd" g_socket_get_fd :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO Int32 socketGetFd :: (MonadIO m, SocketK a) => a -> -- _obj m Int32 socketGetFd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_fd _obj' touchManagedPtr _obj return result -- method Socket::get_keepalive -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_get_keepalive" g_socket_get_keepalive :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CInt socketGetKeepalive :: (MonadIO m, SocketK a) => a -> -- _obj m Bool socketGetKeepalive _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_keepalive _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Socket::get_listen_backlog -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_socket_get_listen_backlog" g_socket_get_listen_backlog :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO Int32 socketGetListenBacklog :: (MonadIO m, SocketK a) => a -> -- _obj m Int32 socketGetListenBacklog _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_listen_backlog _obj' touchManagedPtr _obj return result -- method Socket::get_local_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddress" -- throws : True -- Skip return : False foreign import ccall "g_socket_get_local_address" g_socket_get_local_address :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr (Ptr GError) -> -- error IO (Ptr SocketAddress) socketGetLocalAddress :: (MonadIO m, SocketK a) => a -> -- _obj m SocketAddress socketGetLocalAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_socket_get_local_address _obj' checkUnexpectedReturnNULL "g_socket_get_local_address" result result' <- (wrapObject SocketAddress) result touchManagedPtr _obj return result' ) (do return () ) -- method Socket::get_multicast_loopback -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_get_multicast_loopback" g_socket_get_multicast_loopback :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CInt socketGetMulticastLoopback :: (MonadIO m, SocketK a) => a -> -- _obj m Bool socketGetMulticastLoopback _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_multicast_loopback _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Socket::get_multicast_ttl -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_socket_get_multicast_ttl" g_socket_get_multicast_ttl :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO Word32 socketGetMulticastTtl :: (MonadIO m, SocketK a) => a -> -- _obj m Word32 socketGetMulticastTtl _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_multicast_ttl _obj' touchManagedPtr _obj return result -- method Socket::get_option -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "optname", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "optname", 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_socket_get_option" g_socket_get_option :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Int32 -> -- level : TBasicType TInt32 Int32 -> -- optname : TBasicType TInt32 Ptr Int32 -> -- value : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt socketGetOption :: (MonadIO m, SocketK a) => a -> -- _obj Int32 -> -- level Int32 -> -- optname m (Int32) socketGetOption _obj level optname = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj value <- allocMem :: IO (Ptr Int32) onException (do _ <- propagateGError $ g_socket_get_option _obj' level optname value value' <- peek value touchManagedPtr _obj freeMem value return value' ) (do freeMem value ) -- method Socket::get_protocol -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketProtocol" -- throws : False -- Skip return : False foreign import ccall "g_socket_get_protocol" g_socket_get_protocol :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CUInt socketGetProtocol :: (MonadIO m, SocketK a) => a -> -- _obj m SocketProtocol socketGetProtocol _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_protocol _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Socket::get_remote_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddress" -- throws : True -- Skip return : False foreign import ccall "g_socket_get_remote_address" g_socket_get_remote_address :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr (Ptr GError) -> -- error IO (Ptr SocketAddress) socketGetRemoteAddress :: (MonadIO m, SocketK a) => a -> -- _obj m SocketAddress socketGetRemoteAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_socket_get_remote_address _obj' checkUnexpectedReturnNULL "g_socket_get_remote_address" result result' <- (wrapObject SocketAddress) result touchManagedPtr _obj return result' ) (do return () ) -- method Socket::get_socket_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketType" -- throws : False -- Skip return : False foreign import ccall "g_socket_get_socket_type" g_socket_get_socket_type :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CUInt socketGetSocketType :: (MonadIO m, SocketK a) => a -> -- _obj m SocketType socketGetSocketType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_socket_type _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Socket::get_timeout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_socket_get_timeout" g_socket_get_timeout :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO Word32 socketGetTimeout :: (MonadIO m, SocketK a) => a -> -- _obj m Word32 socketGetTimeout _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_timeout _obj' touchManagedPtr _obj return result -- method Socket::get_ttl -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_socket_get_ttl" g_socket_get_ttl :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO Word32 socketGetTtl :: (MonadIO m, SocketK a) => a -> -- _obj m Word32 socketGetTtl _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_get_ttl _obj' touchManagedPtr _obj return result -- method Socket::is_closed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_is_closed" g_socket_is_closed :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CInt socketIsClosed :: (MonadIO m, SocketK a) => a -> -- _obj m Bool socketIsClosed _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_is_closed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Socket::is_connected -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_is_connected" g_socket_is_connected :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CInt socketIsConnected :: (MonadIO m, SocketK a) => a -> -- _obj m Bool socketIsConnected _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_is_connected _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Socket::join_multicast_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_specific", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iface", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_specific", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iface", 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_socket_join_multicast_group" g_socket_join_multicast_group :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr InetAddress -> -- group : TInterface "Gio" "InetAddress" CInt -> -- source_specific : TBasicType TBoolean CString -> -- iface : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt socketJoinMulticastGroup :: (MonadIO m, SocketK a, InetAddressK b) => a -> -- _obj b -> -- group Bool -> -- source_specific Maybe (T.Text) -> -- iface m () socketJoinMulticastGroup _obj group source_specific iface = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let group' = unsafeManagedPtrCastPtr group let source_specific' = (fromIntegral . fromEnum) source_specific maybeIface <- case iface of Nothing -> return nullPtr Just jIface -> do jIface' <- textToCString jIface return jIface' onException (do _ <- propagateGError $ g_socket_join_multicast_group _obj' group' source_specific' maybeIface touchManagedPtr _obj touchManagedPtr group freeMem maybeIface return () ) (do freeMem maybeIface ) -- method Socket::leave_multicast_group -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_specific", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iface", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "Gio" "InetAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_specific", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iface", 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_socket_leave_multicast_group" g_socket_leave_multicast_group :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr InetAddress -> -- group : TInterface "Gio" "InetAddress" CInt -> -- source_specific : TBasicType TBoolean CString -> -- iface : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt socketLeaveMulticastGroup :: (MonadIO m, SocketK a, InetAddressK b) => a -> -- _obj b -> -- group Bool -> -- source_specific Maybe (T.Text) -> -- iface m () socketLeaveMulticastGroup _obj group source_specific iface = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let group' = unsafeManagedPtrCastPtr group let source_specific' = (fromIntegral . fromEnum) source_specific maybeIface <- case iface of Nothing -> return nullPtr Just jIface -> do jIface' <- textToCString jIface return jIface' onException (do _ <- propagateGError $ g_socket_leave_multicast_group _obj' group' source_specific' maybeIface touchManagedPtr _obj touchManagedPtr group freeMem maybeIface return () ) (do freeMem maybeIface ) -- method Socket::listen -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_listen" g_socket_listen :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr (Ptr GError) -> -- error IO CInt socketListen :: (MonadIO m, SocketK a) => a -> -- _obj m () socketListen _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_socket_listen _obj' touchManagedPtr _obj return () ) (do return () ) -- method Socket::receive -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, 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 = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_socket_receive" g_socket_receive :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- size : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 socketReceive :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m Int64 socketReceive _obj buffer cancellable = liftIO $ do let size = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_receive _obj' buffer' size maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- method Socket::receive_from -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "buffer", argType = TCArray False (-1) 3 (TBasicType TUInt8), 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, 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 = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 3 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_socket_receive_from" g_socket_receive_from :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr (Ptr SocketAddress) -> -- address : TInterface "Gio" "SocketAddress" Ptr Word8 -> -- buffer : TCArray False (-1) 3 (TBasicType TUInt8) Word64 -> -- size : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 socketReceiveFrom :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m (Int64,SocketAddress) socketReceiveFrom _obj buffer cancellable = liftIO $ do let size = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj address <- allocMem :: IO (Ptr (Ptr SocketAddress)) buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_receive_from _obj' address buffer' size maybeCancellable address' <- peek address address'' <- (wrapObject SocketAddress) address' touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem address freeMem buffer' return (result, address'') ) (do freeMem address freeMem buffer' ) -- method Socket::receive_message -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "vectors", argType = TCArray False (-1) 3 (TInterface "Gio" "InputVector"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_vectors", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "messages", argType = TCArray False (-1) 5 (TInterface "Gio" "SocketControlMessage"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_messages", 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "num_messages", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_vectors", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "vectors", argType = TCArray False (-1) 3 (TInterface "Gio" "InputVector"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "messages", argType = TCArray False (-1) 5 (TInterface "Gio" "SocketControlMessage"), direction = DirectionIn, mayBeNull = True, 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_socket_receive_message" g_socket_receive_message :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr (Ptr SocketAddress) -> -- address : TInterface "Gio" "SocketAddress" Ptr InputVector -> -- vectors : TCArray False (-1) 3 (TInterface "Gio" "InputVector") Int32 -> -- num_vectors : TBasicType TInt32 Ptr (Ptr SocketControlMessage) -> -- messages : TCArray False (-1) 5 (TInterface "Gio" "SocketControlMessage") Int32 -> -- num_messages : TBasicType TInt32 Int32 -> -- flags : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 socketReceiveMessage :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj [InputVector] -> -- vectors Maybe ([SocketControlMessage]) -> -- messages Int32 -> -- flags Maybe (b) -> -- cancellable m (Int64,SocketAddress) socketReceiveMessage _obj vectors messages flags cancellable = liftIO $ do let num_messages = case messages of Nothing -> 0 Just jMessages -> fromIntegral $ length jMessages let num_vectors = fromIntegral $ length vectors let _obj' = unsafeManagedPtrCastPtr _obj address <- allocMem :: IO (Ptr (Ptr SocketAddress)) let vectors' = map unsafeManagedPtrGetPtr vectors vectors'' <- packBlockArray 16 vectors' maybeMessages <- case messages of Nothing -> return nullPtr Just jMessages -> do let jMessages' = map unsafeManagedPtrCastPtr jMessages jMessages'' <- packPtrArray jMessages' return jMessages'' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_receive_message _obj' address vectors'' num_vectors maybeMessages num_messages flags maybeCancellable address' <- peek address address'' <- (wrapObject SocketAddress) address' touchManagedPtr _obj mapM_ touchManagedPtr vectors whenJust messages (mapM_ touchManagedPtr) whenJust cancellable touchManagedPtr freeMem address freeMem vectors'' freeMem maybeMessages return (result, address'') ) (do freeMem address freeMem vectors'' freeMem maybeMessages ) -- method Socket::receive_with_blocking -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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},Arg {argName = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, 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 = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_socket_receive_with_blocking" g_socket_receive_with_blocking :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- size : TBasicType TUInt64 CInt -> -- blocking : TBasicType TBoolean Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 socketReceiveWithBlocking :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Bool -> -- blocking Maybe (b) -> -- cancellable m Int64 socketReceiveWithBlocking _obj buffer blocking cancellable = liftIO $ do let size = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer let blocking' = (fromIntegral . fromEnum) blocking maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_receive_with_blocking _obj' buffer' size blocking' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- method Socket::send -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, 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 = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_socket_send" g_socket_send :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- size : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 socketSend :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Maybe (b) -> -- cancellable m Int64 socketSend _obj buffer cancellable = liftIO $ do let size = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_send _obj' buffer' size maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- method Socket::send_message -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "vectors", argType = TCArray False (-1) 3 (TInterface "Gio" "OutputVector"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_vectors", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "messages", argType = TCArray False (-1) 5 (TInterface "Gio" "SocketControlMessage"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_messages", 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "num_messages", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_vectors", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "vectors", argType = TCArray False (-1) 3 (TInterface "Gio" "OutputVector"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "messages", argType = TCArray False (-1) 5 (TInterface "Gio" "SocketControlMessage"), direction = DirectionIn, mayBeNull = True, 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_socket_send_message" g_socket_send_message :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr SocketAddress -> -- address : TInterface "Gio" "SocketAddress" Ptr OutputVector -> -- vectors : TCArray False (-1) 3 (TInterface "Gio" "OutputVector") Int32 -> -- num_vectors : TBasicType TInt32 Ptr (Ptr SocketControlMessage) -> -- messages : TCArray False (-1) 5 (TInterface "Gio" "SocketControlMessage") Int32 -> -- num_messages : TBasicType TInt32 Int32 -> -- flags : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 socketSendMessage :: (MonadIO m, SocketK a, SocketAddressK b, CancellableK c) => a -> -- _obj Maybe (b) -> -- address [OutputVector] -> -- vectors Maybe ([SocketControlMessage]) -> -- messages Int32 -> -- flags Maybe (c) -> -- cancellable m Int64 socketSendMessage _obj address vectors messages flags cancellable = liftIO $ do let num_messages = case messages of Nothing -> 0 Just jMessages -> fromIntegral $ length jMessages let num_vectors = fromIntegral $ length vectors let _obj' = unsafeManagedPtrCastPtr _obj maybeAddress <- case address of Nothing -> return nullPtr Just jAddress -> do let jAddress' = unsafeManagedPtrCastPtr jAddress return jAddress' let vectors' = map unsafeManagedPtrGetPtr vectors vectors'' <- packBlockArray 16 vectors' maybeMessages <- case messages of Nothing -> return nullPtr Just jMessages -> do let jMessages' = map unsafeManagedPtrCastPtr jMessages jMessages'' <- packPtrArray jMessages' return jMessages'' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_send_message _obj' maybeAddress vectors'' num_vectors maybeMessages num_messages flags maybeCancellable touchManagedPtr _obj whenJust address touchManagedPtr mapM_ touchManagedPtr vectors whenJust messages (mapM_ touchManagedPtr) whenJust cancellable touchManagedPtr freeMem vectors'' freeMem maybeMessages return result ) (do freeMem vectors'' freeMem maybeMessages ) -- method Socket::send_messages -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "messages", argType = TCArray False (-1) 2 (TInterface "Gio" "OutputMessage"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_messages", argType = TBasicType TUInt32, 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "num_messages", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "messages", argType = TCArray False (-1) 2 (TInterface "Gio" "OutputMessage"), 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_socket_send_messages" g_socket_send_messages :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr OutputMessage -> -- messages : TCArray False (-1) 2 (TInterface "Gio" "OutputMessage") Word32 -> -- num_messages : TBasicType TUInt32 Int32 -> -- flags : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int32 socketSendMessages :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj [OutputMessage] -> -- messages Int32 -> -- flags Maybe (b) -> -- cancellable m Int32 socketSendMessages _obj messages flags cancellable = liftIO $ do let num_messages = fromIntegral $ length messages let _obj' = unsafeManagedPtrCastPtr _obj let messages' = map unsafeManagedPtrGetPtr messages messages'' <- packBlockArray 40 messages' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_send_messages _obj' messages'' num_messages flags maybeCancellable touchManagedPtr _obj mapM_ touchManagedPtr messages whenJust cancellable touchManagedPtr freeMem messages'' return result ) (do freeMem messages'' ) -- method Socket::send_to -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 3 (TBasicType TUInt8), 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, 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 = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 3 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_socket_send_to" g_socket_send_to :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr SocketAddress -> -- address : TInterface "Gio" "SocketAddress" Ptr Word8 -> -- buffer : TCArray False (-1) 3 (TBasicType TUInt8) Word64 -> -- size : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 socketSendTo :: (MonadIO m, SocketK a, SocketAddressK b, CancellableK c) => a -> -- _obj Maybe (b) -> -- address ByteString -> -- buffer Maybe (c) -> -- cancellable m Int64 socketSendTo _obj address buffer cancellable = liftIO $ do let size = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj maybeAddress <- case address of Nothing -> return nullPtr Just jAddress -> do let jAddress' = unsafeManagedPtrCastPtr jAddress return jAddress' buffer' <- packByteString buffer maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_send_to _obj' maybeAddress buffer' size maybeCancellable touchManagedPtr _obj whenJust address touchManagedPtr whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- method Socket::send_with_blocking -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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},Arg {argName = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, 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 = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_socket_send_with_blocking" g_socket_send_with_blocking :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- size : TBasicType TUInt64 CInt -> -- blocking : TBasicType TBoolean Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 socketSendWithBlocking :: (MonadIO m, SocketK a, CancellableK b) => a -> -- _obj ByteString -> -- buffer Bool -> -- blocking Maybe (b) -> -- cancellable m Int64 socketSendWithBlocking _obj buffer blocking cancellable = liftIO $ do let size = fromIntegral $ B.length buffer let _obj' = unsafeManagedPtrCastPtr _obj buffer' <- packByteString buffer let blocking' = (fromIntegral . fromEnum) blocking maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_send_with_blocking _obj' buffer' size blocking' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- method Socket::set_blocking -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blocking", 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_socket_set_blocking" g_socket_set_blocking :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" CInt -> -- blocking : TBasicType TBoolean IO () socketSetBlocking :: (MonadIO m, SocketK a) => a -> -- _obj Bool -> -- blocking m () socketSetBlocking _obj blocking = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let blocking' = (fromIntegral . fromEnum) blocking g_socket_set_blocking _obj' blocking' touchManagedPtr _obj return () -- method Socket::set_broadcast -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "broadcast", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "broadcast", 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_socket_set_broadcast" g_socket_set_broadcast :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" CInt -> -- broadcast : TBasicType TBoolean IO () socketSetBroadcast :: (MonadIO m, SocketK a) => a -> -- _obj Bool -> -- broadcast m () socketSetBroadcast _obj broadcast = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let broadcast' = (fromIntegral . fromEnum) broadcast g_socket_set_broadcast _obj' broadcast' touchManagedPtr _obj return () -- method Socket::set_keepalive -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keepalive", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "keepalive", 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_socket_set_keepalive" g_socket_set_keepalive :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" CInt -> -- keepalive : TBasicType TBoolean IO () socketSetKeepalive :: (MonadIO m, SocketK a) => a -> -- _obj Bool -> -- keepalive m () socketSetKeepalive _obj keepalive = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let keepalive' = (fromIntegral . fromEnum) keepalive g_socket_set_keepalive _obj' keepalive' touchManagedPtr _obj return () -- method Socket::set_listen_backlog -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "backlog", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "backlog", 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_socket_set_listen_backlog" g_socket_set_listen_backlog :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Int32 -> -- backlog : TBasicType TInt32 IO () socketSetListenBacklog :: (MonadIO m, SocketK a) => a -> -- _obj Int32 -> -- backlog m () socketSetListenBacklog _obj backlog = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_set_listen_backlog _obj' backlog touchManagedPtr _obj return () -- method Socket::set_multicast_loopback -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "loopback", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "loopback", 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_socket_set_multicast_loopback" g_socket_set_multicast_loopback :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" CInt -> -- loopback : TBasicType TBoolean IO () socketSetMulticastLoopback :: (MonadIO m, SocketK a) => a -> -- _obj Bool -> -- loopback m () socketSetMulticastLoopback _obj loopback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let loopback' = (fromIntegral . fromEnum) loopback g_socket_set_multicast_loopback _obj' loopback' touchManagedPtr _obj return () -- method Socket::set_multicast_ttl -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ttl", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ttl", 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_socket_set_multicast_ttl" g_socket_set_multicast_ttl :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Word32 -> -- ttl : TBasicType TUInt32 IO () socketSetMulticastTtl :: (MonadIO m, SocketK a) => a -> -- _obj Word32 -> -- ttl m () socketSetMulticastTtl _obj ttl = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_set_multicast_ttl _obj' ttl touchManagedPtr _obj return () -- method Socket::set_option -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "optname", argType = TBasicType TInt32, 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 "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "optname", argType = TBasicType TInt32, 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 TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_set_option" g_socket_set_option :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Int32 -> -- level : TBasicType TInt32 Int32 -> -- optname : TBasicType TInt32 Int32 -> -- value : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt socketSetOption :: (MonadIO m, SocketK a) => a -> -- _obj Int32 -> -- level Int32 -> -- optname Int32 -> -- value m () socketSetOption _obj level optname value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_socket_set_option _obj' level optname value touchManagedPtr _obj return () ) (do return () ) -- method Socket::set_timeout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout", 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_socket_set_timeout" g_socket_set_timeout :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Word32 -> -- timeout : TBasicType TUInt32 IO () socketSetTimeout :: (MonadIO m, SocketK a) => a -> -- _obj Word32 -> -- timeout m () socketSetTimeout _obj timeout = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_set_timeout _obj' timeout touchManagedPtr _obj return () -- method Socket::set_ttl -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ttl", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ttl", 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_socket_set_ttl" g_socket_set_ttl :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" Word32 -> -- ttl : TBasicType TUInt32 IO () socketSetTtl :: (MonadIO m, SocketK a) => a -> -- _obj Word32 -> -- ttl m () socketSetTtl _obj ttl = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_set_ttl _obj' ttl touchManagedPtr _obj return () -- method Socket::shutdown -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "shutdown_read", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "shutdown_write", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "shutdown_read", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "shutdown_write", 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_socket_shutdown" g_socket_shutdown :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" CInt -> -- shutdown_read : TBasicType TBoolean CInt -> -- shutdown_write : TBasicType TBoolean Ptr (Ptr GError) -> -- error IO CInt socketShutdown :: (MonadIO m, SocketK a) => a -> -- _obj Bool -> -- shutdown_read Bool -> -- shutdown_write m () socketShutdown _obj shutdown_read shutdown_write = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let shutdown_read' = (fromIntegral . fromEnum) shutdown_read let shutdown_write' = (fromIntegral . fromEnum) shutdown_write onException (do _ <- propagateGError $ g_socket_shutdown _obj' shutdown_read' shutdown_write' touchManagedPtr _obj return () ) (do return () ) -- method Socket::speaks_ipv4 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_speaks_ipv4" g_socket_speaks_ipv4 :: Ptr Socket -> -- _obj : TInterface "Gio" "Socket" IO CInt socketSpeaksIpv4 :: (MonadIO m, SocketK a) => a -> -- _obj m Bool socketSpeaksIpv4 _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_speaks_ipv4 _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- object SocketAddress newtype SocketAddress = SocketAddress (ForeignPtr SocketAddress) noSocketAddress :: Maybe SocketAddress noSocketAddress = Nothing foreign import ccall "g_socket_address_get_type" c_g_socket_address_get_type :: IO GType type instance ParentTypes SocketAddress = '[GObject.Object, SocketConnectable] instance GObject SocketAddress where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_address_get_type class GObject o => SocketAddressK o instance (GObject o, IsDescendantOf SocketAddress o) => SocketAddressK o toSocketAddress :: SocketAddressK o => o -> IO SocketAddress toSocketAddress = unsafeCastTo SocketAddress -- method SocketAddress::new_from_native -- method type : Constructor -- Args : [Arg {argName = "native", argType = TBasicType TVoid, 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 = "native", argType = TBasicType TVoid, 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 "Gio" "SocketAddress" -- throws : False -- Skip return : False foreign import ccall "g_socket_address_new_from_native" g_socket_address_new_from_native :: Ptr () -> -- native : TBasicType TVoid Word64 -> -- len : TBasicType TUInt64 IO (Ptr SocketAddress) socketAddressNewFromNative :: (MonadIO m) => Ptr () -> -- native Word64 -> -- len m SocketAddress socketAddressNewFromNative native len = liftIO $ do result <- g_socket_address_new_from_native native len checkUnexpectedReturnNULL "g_socket_address_new_from_native" result result' <- (wrapObject SocketAddress) result return result' -- method SocketAddress::get_family -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketFamily" -- throws : False -- Skip return : False foreign import ccall "g_socket_address_get_family" g_socket_address_get_family :: Ptr SocketAddress -> -- _obj : TInterface "Gio" "SocketAddress" IO CUInt socketAddressGetFamily :: (MonadIO m, SocketAddressK a) => a -> -- _obj m SocketFamily socketAddressGetFamily _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_address_get_family _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method SocketAddress::get_native_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : False -- Skip return : False foreign import ccall "g_socket_address_get_native_size" g_socket_address_get_native_size :: Ptr SocketAddress -> -- _obj : TInterface "Gio" "SocketAddress" IO Int64 socketAddressGetNativeSize :: (MonadIO m, SocketAddressK a) => a -> -- _obj m Int64 socketAddressGetNativeSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_address_get_native_size _obj' touchManagedPtr _obj return result -- method SocketAddress::to_native -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destlen", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destlen", 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_socket_address_to_native" g_socket_address_to_native :: Ptr SocketAddress -> -- _obj : TInterface "Gio" "SocketAddress" Ptr () -> -- dest : TBasicType TVoid Word64 -> -- destlen : TBasicType TUInt64 Ptr (Ptr GError) -> -- error IO CInt socketAddressToNative :: (MonadIO m, SocketAddressK a) => a -> -- _obj Ptr () -> -- dest Word64 -> -- destlen m () socketAddressToNative _obj dest destlen = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_socket_address_to_native _obj' dest destlen touchManagedPtr _obj return () ) (do return () ) -- object SocketAddressEnumerator newtype SocketAddressEnumerator = SocketAddressEnumerator (ForeignPtr SocketAddressEnumerator) noSocketAddressEnumerator :: Maybe SocketAddressEnumerator noSocketAddressEnumerator = Nothing foreign import ccall "g_socket_address_enumerator_get_type" c_g_socket_address_enumerator_get_type :: IO GType type instance ParentTypes SocketAddressEnumerator = '[GObject.Object] instance GObject SocketAddressEnumerator where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_address_enumerator_get_type class GObject o => SocketAddressEnumeratorK o instance (GObject o, IsDescendantOf SocketAddressEnumerator o) => SocketAddressEnumeratorK o toSocketAddressEnumerator :: SocketAddressEnumeratorK o => o -> IO SocketAddressEnumerator toSocketAddressEnumerator = unsafeCastTo SocketAddressEnumerator -- method SocketAddressEnumerator::next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddressEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddressEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddress" -- throws : True -- Skip return : False foreign import ccall "g_socket_address_enumerator_next" g_socket_address_enumerator_next :: Ptr SocketAddressEnumerator -> -- _obj : TInterface "Gio" "SocketAddressEnumerator" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr SocketAddress) socketAddressEnumeratorNext :: (MonadIO m, SocketAddressEnumeratorK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m SocketAddress socketAddressEnumeratorNext _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_address_enumerator_next _obj' maybeCancellable checkUnexpectedReturnNULL "g_socket_address_enumerator_next" result result' <- (wrapObject SocketAddress) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method SocketAddressEnumerator::next_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddressEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "SocketAddressEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_address_enumerator_next_async" g_socket_address_enumerator_next_async :: Ptr SocketAddressEnumerator -> -- _obj : TInterface "Gio" "SocketAddressEnumerator" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () socketAddressEnumeratorNextAsync :: (MonadIO m, SocketAddressEnumeratorK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () socketAddressEnumeratorNextAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_socket_address_enumerator_next_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method SocketAddressEnumerator::next_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddressEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketAddressEnumerator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddress" -- throws : True -- Skip return : False foreign import ccall "g_socket_address_enumerator_next_finish" g_socket_address_enumerator_next_finish :: Ptr SocketAddressEnumerator -> -- _obj : TInterface "Gio" "SocketAddressEnumerator" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr SocketAddress) socketAddressEnumeratorNextFinish :: (MonadIO m, SocketAddressEnumeratorK a, AsyncResultK b) => a -> -- _obj b -> -- result m SocketAddress socketAddressEnumeratorNextFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_socket_address_enumerator_next_finish _obj' result_' checkUnexpectedReturnNULL "g_socket_address_enumerator_next_finish" result result' <- (wrapObject SocketAddress) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- object SocketClient newtype SocketClient = SocketClient (ForeignPtr SocketClient) noSocketClient :: Maybe SocketClient noSocketClient = Nothing foreign import ccall "g_socket_client_get_type" c_g_socket_client_get_type :: IO GType type instance ParentTypes SocketClient = '[GObject.Object] instance GObject SocketClient where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_client_get_type class GObject o => SocketClientK o instance (GObject o, IsDescendantOf SocketClient o) => SocketClientK o toSocketClient :: SocketClientK o => o -> IO SocketClient toSocketClient = unsafeCastTo SocketClient -- method SocketClient::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "SocketClient" -- throws : False -- Skip return : False foreign import ccall "g_socket_client_new" g_socket_client_new :: IO (Ptr SocketClient) socketClientNew :: (MonadIO m) => m SocketClient socketClientNew = liftIO $ do result <- g_socket_client_new checkUnexpectedReturnNULL "g_socket_client_new" result result' <- (wrapObject SocketClient) result return result' -- method SocketClient::add_application_proxy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", 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_socket_client_add_application_proxy" g_socket_client_add_application_proxy :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CString -> -- protocol : TBasicType TUTF8 IO () socketClientAddApplicationProxy :: (MonadIO m, SocketClientK a) => a -> -- _obj T.Text -> -- protocol m () socketClientAddApplicationProxy _obj protocol = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj protocol' <- textToCString protocol g_socket_client_add_application_proxy _obj' protocol' touchManagedPtr _obj freeMem protocol' return () -- method SocketClient::connect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connectable", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connectable", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_client_connect" g_socket_client_connect :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Ptr SocketConnectable -> -- connectable : TInterface "Gio" "SocketConnectable" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketClientConnect :: (MonadIO m, SocketClientK a, SocketConnectableK b, CancellableK c) => a -> -- _obj b -> -- connectable Maybe (c) -> -- cancellable m SocketConnection socketClientConnect _obj connectable cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connectable' = unsafeManagedPtrCastPtr connectable maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_client_connect _obj' connectable' maybeCancellable checkUnexpectedReturnNULL "g_socket_client_connect" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj touchManagedPtr connectable whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method SocketClient::connect_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connectable", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connectable", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_connect_async" g_socket_client_connect_async :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Ptr SocketConnectable -> -- connectable : TInterface "Gio" "SocketConnectable" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () socketClientConnectAsync :: (MonadIO m, SocketClientK a, SocketConnectableK b, CancellableK c) => a -> -- _obj b -> -- connectable Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () socketClientConnectAsync _obj connectable cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connectable' = unsafeManagedPtrCastPtr connectable maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_socket_client_connect_async _obj' connectable' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr connectable whenJust cancellable touchManagedPtr return () -- method SocketClient::connect_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_client_connect_finish" g_socket_client_connect_finish :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketClientConnectFinish :: (MonadIO m, SocketClientK a, AsyncResultK b) => a -> -- _obj b -> -- result m SocketConnection socketClientConnectFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_socket_client_connect_finish _obj' result_' checkUnexpectedReturnNULL "g_socket_client_connect_finish" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method SocketClient::connect_to_host -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "host_and_port", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "host_and_port", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_client_connect_to_host" g_socket_client_connect_to_host :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CString -> -- host_and_port : TBasicType TUTF8 Word16 -> -- default_port : TBasicType TUInt16 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketClientConnectToHost :: (MonadIO m, SocketClientK a, CancellableK b) => a -> -- _obj T.Text -> -- host_and_port Word16 -> -- default_port Maybe (b) -> -- cancellable m SocketConnection socketClientConnectToHost _obj host_and_port default_port cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj host_and_port' <- textToCString host_and_port maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_client_connect_to_host _obj' host_and_port' default_port maybeCancellable checkUnexpectedReturnNULL "g_socket_client_connect_to_host" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem host_and_port' return result' ) (do freeMem host_and_port' ) -- method SocketClient::connect_to_host_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "host_and_port", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "host_and_port", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_connect_to_host_async" g_socket_client_connect_to_host_async :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CString -> -- host_and_port : TBasicType TUTF8 Word16 -> -- default_port : TBasicType TUInt16 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () socketClientConnectToHostAsync :: (MonadIO m, SocketClientK a, CancellableK b) => a -> -- _obj T.Text -> -- host_and_port Word16 -> -- default_port Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () socketClientConnectToHostAsync _obj host_and_port default_port cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj host_and_port' <- textToCString host_and_port maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_socket_client_connect_to_host_async _obj' host_and_port' default_port maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem host_and_port' return () -- method SocketClient::connect_to_host_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_client_connect_to_host_finish" g_socket_client_connect_to_host_finish :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketClientConnectToHostFinish :: (MonadIO m, SocketClientK a, AsyncResultK b) => a -> -- _obj b -> -- result m SocketConnection socketClientConnectToHostFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_socket_client_connect_to_host_finish _obj' result_' checkUnexpectedReturnNULL "g_socket_client_connect_to_host_finish" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method SocketClient::connect_to_service -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", 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},Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", 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},Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_client_connect_to_service" g_socket_client_connect_to_service :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CString -> -- domain : TBasicType TUTF8 CString -> -- service : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketClientConnectToService :: (MonadIO m, SocketClientK a, CancellableK b) => a -> -- _obj T.Text -> -- domain T.Text -> -- service Maybe (b) -> -- cancellable m SocketConnection socketClientConnectToService _obj domain service cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj domain' <- textToCString domain service' <- textToCString service maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_client_connect_to_service _obj' domain' service' maybeCancellable checkUnexpectedReturnNULL "g_socket_client_connect_to_service" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem domain' freeMem service' return result' ) (do freeMem domain' freeMem service' ) -- method SocketClient::connect_to_service_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", 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},Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", 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},Arg {argName = "service", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_connect_to_service_async" g_socket_client_connect_to_service_async :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CString -> -- domain : TBasicType TUTF8 CString -> -- service : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () socketClientConnectToServiceAsync :: (MonadIO m, SocketClientK a, CancellableK b) => a -> -- _obj T.Text -> -- domain T.Text -> -- service Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () socketClientConnectToServiceAsync _obj domain service cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj domain' <- textToCString domain service' <- textToCString service maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_socket_client_connect_to_service_async _obj' domain' service' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem domain' freeMem service' return () -- method SocketClient::connect_to_service_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_client_connect_to_service_finish" g_socket_client_connect_to_service_finish :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketClientConnectToServiceFinish :: (MonadIO m, SocketClientK a, AsyncResultK b) => a -> -- _obj b -> -- result m SocketConnection socketClientConnectToServiceFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_socket_client_connect_to_service_finish _obj' result_' checkUnexpectedReturnNULL "g_socket_client_connect_to_service_finish" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method SocketClient::connect_to_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", 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 = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", 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 = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_client_connect_to_uri" g_socket_client_connect_to_uri :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CString -> -- uri : TBasicType TUTF8 Word16 -> -- default_port : TBasicType TUInt16 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketClientConnectToUri :: (MonadIO m, SocketClientK a, CancellableK b) => a -> -- _obj T.Text -> -- uri Word16 -> -- default_port Maybe (b) -> -- cancellable m SocketConnection socketClientConnectToUri _obj uri default_port cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_client_connect_to_uri _obj' uri' default_port maybeCancellable checkUnexpectedReturnNULL "g_socket_client_connect_to_uri" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem uri' return result' ) (do freeMem uri' ) -- method SocketClient::connect_to_uri_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", 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 = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", 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 = "default_port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_connect_to_uri_async" g_socket_client_connect_to_uri_async :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CString -> -- uri : TBasicType TUTF8 Word16 -> -- default_port : TBasicType TUInt16 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () socketClientConnectToUriAsync :: (MonadIO m, SocketClientK a, CancellableK b) => a -> -- _obj T.Text -> -- uri Word16 -> -- default_port Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () socketClientConnectToUriAsync _obj uri default_port cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_socket_client_connect_to_uri_async _obj' uri' default_port maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem uri' return () -- method SocketClient::connect_to_uri_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_client_connect_to_uri_finish" g_socket_client_connect_to_uri_finish :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketClientConnectToUriFinish :: (MonadIO m, SocketClientK a, AsyncResultK b) => a -> -- _obj b -> -- result m SocketConnection socketClientConnectToUriFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_socket_client_connect_to_uri_finish _obj' result_' checkUnexpectedReturnNULL "g_socket_client_connect_to_uri_finish" result result' <- (wrapObject SocketConnection) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method SocketClient::get_enable_proxy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_enable_proxy" g_socket_client_get_enable_proxy :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO CInt socketClientGetEnableProxy :: (MonadIO m, SocketClientK a) => a -> -- _obj m Bool socketClientGetEnableProxy _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_enable_proxy _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method SocketClient::get_family -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketFamily" -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_family" g_socket_client_get_family :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO CUInt socketClientGetFamily :: (MonadIO m, SocketClientK a) => a -> -- _obj m SocketFamily socketClientGetFamily _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_family _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method SocketClient::get_local_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddress" -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_local_address" g_socket_client_get_local_address :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO (Ptr SocketAddress) socketClientGetLocalAddress :: (MonadIO m, SocketClientK a) => a -> -- _obj m SocketAddress socketClientGetLocalAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_local_address _obj' checkUnexpectedReturnNULL "g_socket_client_get_local_address" result result' <- (newObject SocketAddress) result touchManagedPtr _obj return result' -- method SocketClient::get_protocol -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketProtocol" -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_protocol" g_socket_client_get_protocol :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO CUInt socketClientGetProtocol :: (MonadIO m, SocketClientK a) => a -> -- _obj m SocketProtocol socketClientGetProtocol _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_protocol _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method SocketClient::get_proxy_resolver -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ProxyResolver" -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_proxy_resolver" g_socket_client_get_proxy_resolver :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO (Ptr ProxyResolver) socketClientGetProxyResolver :: (MonadIO m, SocketClientK a) => a -> -- _obj m ProxyResolver socketClientGetProxyResolver _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_proxy_resolver _obj' checkUnexpectedReturnNULL "g_socket_client_get_proxy_resolver" result result' <- (newObject ProxyResolver) result touchManagedPtr _obj return result' -- method SocketClient::get_socket_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketType" -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_socket_type" g_socket_client_get_socket_type :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO CUInt socketClientGetSocketType :: (MonadIO m, SocketClientK a) => a -> -- _obj m SocketType socketClientGetSocketType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_socket_type _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method SocketClient::get_timeout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_timeout" g_socket_client_get_timeout :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO Word32 socketClientGetTimeout :: (MonadIO m, SocketClientK a) => a -> -- _obj m Word32 socketClientGetTimeout _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_timeout _obj' touchManagedPtr _obj return result -- method SocketClient::get_tls -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_tls" g_socket_client_get_tls :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO CInt socketClientGetTls :: (MonadIO m, SocketClientK a) => a -> -- _obj m Bool socketClientGetTls _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_tls _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method SocketClient::get_tls_validation_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificateFlags" -- throws : False -- Skip return : False foreign import ccall "g_socket_client_get_tls_validation_flags" g_socket_client_get_tls_validation_flags :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" IO CUInt socketClientGetTlsValidationFlags :: (MonadIO m, SocketClientK a) => a -> -- _obj m [TlsCertificateFlags] socketClientGetTlsValidationFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_client_get_tls_validation_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method SocketClient::set_enable_proxy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enable", 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_socket_client_set_enable_proxy" g_socket_client_set_enable_proxy :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CInt -> -- enable : TBasicType TBoolean IO () socketClientSetEnableProxy :: (MonadIO m, SocketClientK a) => a -> -- _obj Bool -> -- enable m () socketClientSetEnableProxy _obj enable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let enable' = (fromIntegral . fromEnum) enable g_socket_client_set_enable_proxy _obj' enable' touchManagedPtr _obj return () -- method SocketClient::set_family -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_set_family" g_socket_client_set_family :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CUInt -> -- family : TInterface "Gio" "SocketFamily" IO () socketClientSetFamily :: (MonadIO m, SocketClientK a) => a -> -- _obj SocketFamily -> -- family m () socketClientSetFamily _obj family = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let family' = (fromIntegral . fromEnum) family g_socket_client_set_family _obj' family' touchManagedPtr _obj return () -- method SocketClient::set_local_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_set_local_address" g_socket_client_set_local_address :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Ptr SocketAddress -> -- address : TInterface "Gio" "SocketAddress" IO () socketClientSetLocalAddress :: (MonadIO m, SocketClientK a, SocketAddressK b) => a -> -- _obj Maybe (b) -> -- address m () socketClientSetLocalAddress _obj address = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeAddress <- case address of Nothing -> return nullPtr Just jAddress -> do let jAddress' = unsafeManagedPtrCastPtr jAddress return jAddress' g_socket_client_set_local_address _obj' maybeAddress touchManagedPtr _obj whenJust address touchManagedPtr return () -- method SocketClient::set_protocol -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TInterface "Gio" "SocketProtocol", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TInterface "Gio" "SocketProtocol", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_set_protocol" g_socket_client_set_protocol :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CUInt -> -- protocol : TInterface "Gio" "SocketProtocol" IO () socketClientSetProtocol :: (MonadIO m, SocketClientK a) => a -> -- _obj SocketProtocol -> -- protocol m () socketClientSetProtocol _obj protocol = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let protocol' = (fromIntegral . fromEnum) protocol g_socket_client_set_protocol _obj' protocol' touchManagedPtr _obj return () -- method SocketClient::set_proxy_resolver -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "proxy_resolver", argType = TInterface "Gio" "ProxyResolver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "proxy_resolver", argType = TInterface "Gio" "ProxyResolver", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_set_proxy_resolver" g_socket_client_set_proxy_resolver :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Ptr ProxyResolver -> -- proxy_resolver : TInterface "Gio" "ProxyResolver" IO () socketClientSetProxyResolver :: (MonadIO m, SocketClientK a, ProxyResolverK b) => a -> -- _obj Maybe (b) -> -- proxy_resolver m () socketClientSetProxyResolver _obj proxy_resolver = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeProxy_resolver <- case proxy_resolver of Nothing -> return nullPtr Just jProxy_resolver -> do let jProxy_resolver' = unsafeManagedPtrCastPtr jProxy_resolver return jProxy_resolver' g_socket_client_set_proxy_resolver _obj' maybeProxy_resolver touchManagedPtr _obj whenJust proxy_resolver touchManagedPtr return () -- method SocketClient::set_socket_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_set_socket_type" g_socket_client_set_socket_type :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CUInt -> -- type : TInterface "Gio" "SocketType" IO () socketClientSetSocketType :: (MonadIO m, SocketClientK a) => a -> -- _obj SocketType -> -- type m () socketClientSetSocketType _obj type_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let type_' = (fromIntegral . fromEnum) type_ g_socket_client_set_socket_type _obj' type_' touchManagedPtr _obj return () -- method SocketClient::set_timeout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "timeout", 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_socket_client_set_timeout" g_socket_client_set_timeout :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" Word32 -> -- timeout : TBasicType TUInt32 IO () socketClientSetTimeout :: (MonadIO m, SocketClientK a) => a -> -- _obj Word32 -> -- timeout m () socketClientSetTimeout _obj timeout = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_client_set_timeout _obj' timeout touchManagedPtr _obj return () -- method SocketClient::set_tls -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tls", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tls", 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_socket_client_set_tls" g_socket_client_set_tls :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CInt -> -- tls : TBasicType TBoolean IO () socketClientSetTls :: (MonadIO m, SocketClientK a) => a -> -- _obj Bool -> -- tls m () socketClientSetTls _obj tls = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let tls' = (fromIntegral . fromEnum) tls g_socket_client_set_tls _obj' tls' touchManagedPtr _obj return () -- method SocketClient::set_tls_validation_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_client_set_tls_validation_flags" g_socket_client_set_tls_validation_flags :: Ptr SocketClient -> -- _obj : TInterface "Gio" "SocketClient" CUInt -> -- flags : TInterface "Gio" "TlsCertificateFlags" IO () socketClientSetTlsValidationFlags :: (MonadIO m, SocketClientK a) => a -> -- _obj [TlsCertificateFlags] -> -- flags m () socketClientSetTlsValidationFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags g_socket_client_set_tls_validation_flags _obj' flags' touchManagedPtr _obj return () -- signal SocketClient::event type SocketClientEventCallback = SocketClientEvent -> SocketConnectable -> IOStream -> IO () noSocketClientEventCallback :: Maybe SocketClientEventCallback noSocketClientEventCallback = Nothing type SocketClientEventCallbackC = Ptr () -> -- object CUInt -> Ptr SocketConnectable -> Ptr IOStream -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkSocketClientEventCallback :: SocketClientEventCallbackC -> IO (FunPtr SocketClientEventCallbackC) socketClientEventClosure :: SocketClientEventCallback -> IO Closure socketClientEventClosure cb = newCClosure =<< mkSocketClientEventCallback wrapped where wrapped = socketClientEventCallbackWrapper cb socketClientEventCallbackWrapper :: SocketClientEventCallback -> Ptr () -> CUInt -> Ptr SocketConnectable -> Ptr IOStream -> Ptr () -> IO () socketClientEventCallbackWrapper _cb _ event connectable connection _ = do let event' = (toEnum . fromIntegral) event connectable' <- (newObject SocketConnectable) connectable connection' <- (newObject IOStream) connection _cb event' connectable' connection' onSocketClientEvent :: (GObject a, MonadIO m) => a -> SocketClientEventCallback -> m SignalHandlerId onSocketClientEvent obj cb = liftIO $ connectSocketClientEvent obj cb SignalConnectBefore afterSocketClientEvent :: (GObject a, MonadIO m) => a -> SocketClientEventCallback -> m SignalHandlerId afterSocketClientEvent obj cb = connectSocketClientEvent obj cb SignalConnectAfter connectSocketClientEvent :: (GObject a, MonadIO m) => a -> SocketClientEventCallback -> SignalConnectMode -> m SignalHandlerId connectSocketClientEvent obj cb after = liftIO $ do cb' <- mkSocketClientEventCallback (socketClientEventCallbackWrapper cb) connectSignalFunPtr obj "event" cb' after -- Enum SocketClientEvent data SocketClientEvent = SocketClientEventResolving | SocketClientEventResolved | SocketClientEventConnecting | SocketClientEventConnected | SocketClientEventProxyNegotiating | SocketClientEventProxyNegotiated | SocketClientEventTlsHandshaking | SocketClientEventTlsHandshaked | SocketClientEventComplete | AnotherSocketClientEvent Int deriving (Show, Eq) instance Enum SocketClientEvent where fromEnum SocketClientEventResolving = 0 fromEnum SocketClientEventResolved = 1 fromEnum SocketClientEventConnecting = 2 fromEnum SocketClientEventConnected = 3 fromEnum SocketClientEventProxyNegotiating = 4 fromEnum SocketClientEventProxyNegotiated = 5 fromEnum SocketClientEventTlsHandshaking = 6 fromEnum SocketClientEventTlsHandshaked = 7 fromEnum SocketClientEventComplete = 8 fromEnum (AnotherSocketClientEvent k) = k toEnum 0 = SocketClientEventResolving toEnum 1 = SocketClientEventResolved toEnum 2 = SocketClientEventConnecting toEnum 3 = SocketClientEventConnected toEnum 4 = SocketClientEventProxyNegotiating toEnum 5 = SocketClientEventProxyNegotiated toEnum 6 = SocketClientEventTlsHandshaking toEnum 7 = SocketClientEventTlsHandshaked toEnum 8 = SocketClientEventComplete toEnum k = AnotherSocketClientEvent k foreign import ccall "g_socket_client_event_get_type" c_g_socket_client_event_get_type :: IO GType instance BoxedEnum SocketClientEvent where boxedEnumType _ = c_g_socket_client_event_get_type -- interface SocketConnectable newtype SocketConnectable = SocketConnectable (ForeignPtr SocketConnectable) noSocketConnectable :: Maybe SocketConnectable noSocketConnectable = Nothing foreign import ccall "g_socket_connectable_get_type" c_g_socket_connectable_get_type :: IO GType type instance ParentTypes SocketConnectable = '[GObject.Object] instance GObject SocketConnectable where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_connectable_get_type class GObject o => SocketConnectableK o instance (GObject o, IsDescendantOf SocketConnectable o) => SocketConnectableK o toSocketConnectable :: SocketConnectableK o => o -> IO SocketConnectable toSocketConnectable = unsafeCastTo SocketConnectable -- method SocketConnectable::enumerate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddressEnumerator" -- throws : False -- Skip return : False foreign import ccall "g_socket_connectable_enumerate" g_socket_connectable_enumerate :: Ptr SocketConnectable -> -- _obj : TInterface "Gio" "SocketConnectable" IO (Ptr SocketAddressEnumerator) socketConnectableEnumerate :: (MonadIO m, SocketConnectableK a) => a -> -- _obj m SocketAddressEnumerator socketConnectableEnumerate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_connectable_enumerate _obj' checkUnexpectedReturnNULL "g_socket_connectable_enumerate" result result' <- (wrapObject SocketAddressEnumerator) result touchManagedPtr _obj return result' -- method SocketConnectable::proxy_enumerate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddressEnumerator" -- throws : False -- Skip return : False foreign import ccall "g_socket_connectable_proxy_enumerate" g_socket_connectable_proxy_enumerate :: Ptr SocketConnectable -> -- _obj : TInterface "Gio" "SocketConnectable" IO (Ptr SocketAddressEnumerator) socketConnectableProxyEnumerate :: (MonadIO m, SocketConnectableK a) => a -> -- _obj m SocketAddressEnumerator socketConnectableProxyEnumerate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_connectable_proxy_enumerate _obj' checkUnexpectedReturnNULL "g_socket_connectable_proxy_enumerate" result result' <- (wrapObject SocketAddressEnumerator) result touchManagedPtr _obj return result' -- object SocketConnection newtype SocketConnection = SocketConnection (ForeignPtr SocketConnection) noSocketConnection :: Maybe SocketConnection noSocketConnection = Nothing foreign import ccall "g_socket_connection_get_type" c_g_socket_connection_get_type :: IO GType type instance ParentTypes SocketConnection = '[IOStream, GObject.Object] instance GObject SocketConnection where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_connection_get_type class GObject o => SocketConnectionK o instance (GObject o, IsDescendantOf SocketConnection o) => SocketConnectionK o toSocketConnection :: SocketConnectionK o => o -> IO SocketConnection toSocketConnection = unsafeCastTo SocketConnection -- method SocketConnection::connect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_connection_connect" g_socket_connection_connect :: Ptr SocketConnection -> -- _obj : TInterface "Gio" "SocketConnection" Ptr SocketAddress -> -- address : TInterface "Gio" "SocketAddress" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt socketConnectionConnect :: (MonadIO m, SocketConnectionK a, SocketAddressK b, CancellableK c) => a -> -- _obj b -> -- address Maybe (c) -> -- cancellable m () socketConnectionConnect _obj address cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let address' = unsafeManagedPtrCastPtr address maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_socket_connection_connect _obj' address' maybeCancellable touchManagedPtr _obj touchManagedPtr address whenJust cancellable touchManagedPtr return () ) (do return () ) -- method SocketConnection::connect_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_connection_connect_async" g_socket_connection_connect_async :: Ptr SocketConnection -> -- _obj : TInterface "Gio" "SocketConnection" Ptr SocketAddress -> -- address : TInterface "Gio" "SocketAddress" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () socketConnectionConnectAsync :: (MonadIO m, SocketConnectionK a, SocketAddressK b, CancellableK c) => a -> -- _obj b -> -- address Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () socketConnectionConnectAsync _obj address cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let address' = unsafeManagedPtrCastPtr address maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_socket_connection_connect_async _obj' address' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr address whenJust cancellable touchManagedPtr return () -- method SocketConnection::connect_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_connection_connect_finish" g_socket_connection_connect_finish :: Ptr SocketConnection -> -- _obj : TInterface "Gio" "SocketConnection" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt socketConnectionConnectFinish :: (MonadIO m, SocketConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- result m () socketConnectionConnectFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_socket_connection_connect_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method SocketConnection::get_local_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddress" -- throws : True -- Skip return : False foreign import ccall "g_socket_connection_get_local_address" g_socket_connection_get_local_address :: Ptr SocketConnection -> -- _obj : TInterface "Gio" "SocketConnection" Ptr (Ptr GError) -> -- error IO (Ptr SocketAddress) socketConnectionGetLocalAddress :: (MonadIO m, SocketConnectionK a) => a -> -- _obj m SocketAddress socketConnectionGetLocalAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_socket_connection_get_local_address _obj' checkUnexpectedReturnNULL "g_socket_connection_get_local_address" result result' <- (wrapObject SocketAddress) result touchManagedPtr _obj return result' ) (do return () ) -- method SocketConnection::get_remote_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketAddress" -- throws : True -- Skip return : False foreign import ccall "g_socket_connection_get_remote_address" g_socket_connection_get_remote_address :: Ptr SocketConnection -> -- _obj : TInterface "Gio" "SocketConnection" Ptr (Ptr GError) -> -- error IO (Ptr SocketAddress) socketConnectionGetRemoteAddress :: (MonadIO m, SocketConnectionK a) => a -> -- _obj m SocketAddress socketConnectionGetRemoteAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_socket_connection_get_remote_address _obj' checkUnexpectedReturnNULL "g_socket_connection_get_remote_address" result result' <- (wrapObject SocketAddress) result touchManagedPtr _obj return result' ) (do return () ) -- method SocketConnection::get_socket -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Socket" -- throws : False -- Skip return : False foreign import ccall "g_socket_connection_get_socket" g_socket_connection_get_socket :: Ptr SocketConnection -> -- _obj : TInterface "Gio" "SocketConnection" IO (Ptr Socket) socketConnectionGetSocket :: (MonadIO m, SocketConnectionK a) => a -> -- _obj m Socket socketConnectionGetSocket _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_connection_get_socket _obj' checkUnexpectedReturnNULL "g_socket_connection_get_socket" result result' <- (newObject Socket) result touchManagedPtr _obj return result' -- method SocketConnection::is_connected -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_connection_is_connected" g_socket_connection_is_connected :: Ptr SocketConnection -> -- _obj : TInterface "Gio" "SocketConnection" IO CInt socketConnectionIsConnected :: (MonadIO m, SocketConnectionK a) => a -> -- _obj m Bool socketConnectionIsConnected _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_connection_is_connected _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method SocketConnection::factory_lookup_type -- method type : MemberFunction -- Args : [Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol_id", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol_id", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_socket_connection_factory_lookup_type" g_socket_connection_factory_lookup_type :: CUInt -> -- family : TInterface "Gio" "SocketFamily" CUInt -> -- type : TInterface "Gio" "SocketType" Int32 -> -- protocol_id : TBasicType TInt32 IO CGType socketConnectionFactoryLookupType :: (MonadIO m) => SocketFamily -> -- family SocketType -> -- type Int32 -> -- protocol_id m GType socketConnectionFactoryLookupType family type_ protocol_id = liftIO $ do let family' = (fromIntegral . fromEnum) family let type_' = (fromIntegral . fromEnum) type_ result <- g_socket_connection_factory_lookup_type family' type_' protocol_id let result' = GType result return result' -- method SocketConnection::factory_register_type -- method type : MemberFunction -- Args : [Arg {argName = "g_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TInterface "Gio" "SocketFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", 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_socket_connection_factory_register_type" g_socket_connection_factory_register_type :: CGType -> -- g_type : TBasicType TGType CUInt -> -- family : TInterface "Gio" "SocketFamily" CUInt -> -- type : TInterface "Gio" "SocketType" Int32 -> -- protocol : TBasicType TInt32 IO () socketConnectionFactoryRegisterType :: (MonadIO m) => GType -> -- g_type SocketFamily -> -- family SocketType -> -- type Int32 -> -- protocol m () socketConnectionFactoryRegisterType g_type family type_ protocol = liftIO $ do let g_type' = gtypeToCGType g_type let family' = (fromIntegral . fromEnum) family let type_' = (fromIntegral . fromEnum) type_ g_socket_connection_factory_register_type g_type' family' type_' protocol return () -- object SocketControlMessage newtype SocketControlMessage = SocketControlMessage (ForeignPtr SocketControlMessage) noSocketControlMessage :: Maybe SocketControlMessage noSocketControlMessage = Nothing foreign import ccall "g_socket_control_message_get_type" c_g_socket_control_message_get_type :: IO GType type instance ParentTypes SocketControlMessage = '[GObject.Object] instance GObject SocketControlMessage where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_control_message_get_type class GObject o => SocketControlMessageK o instance (GObject o, IsDescendantOf SocketControlMessage o) => SocketControlMessageK o toSocketControlMessage :: SocketControlMessageK o => o -> IO SocketControlMessage toSocketControlMessage = unsafeCastTo SocketControlMessage -- method SocketControlMessage::get_level -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketControlMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketControlMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_socket_control_message_get_level" g_socket_control_message_get_level :: Ptr SocketControlMessage -> -- _obj : TInterface "Gio" "SocketControlMessage" IO Int32 socketControlMessageGetLevel :: (MonadIO m, SocketControlMessageK a) => a -> -- _obj m Int32 socketControlMessageGetLevel _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_control_message_get_level _obj' touchManagedPtr _obj return result -- method SocketControlMessage::get_msg_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketControlMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketControlMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_socket_control_message_get_msg_type" g_socket_control_message_get_msg_type :: Ptr SocketControlMessage -> -- _obj : TInterface "Gio" "SocketControlMessage" IO Int32 socketControlMessageGetMsgType :: (MonadIO m, SocketControlMessageK a) => a -> -- _obj m Int32 socketControlMessageGetMsgType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_control_message_get_msg_type _obj' touchManagedPtr _obj return result -- method SocketControlMessage::get_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketControlMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketControlMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_socket_control_message_get_size" g_socket_control_message_get_size :: Ptr SocketControlMessage -> -- _obj : TInterface "Gio" "SocketControlMessage" IO Word64 socketControlMessageGetSize :: (MonadIO m, SocketControlMessageK a) => a -> -- _obj m Word64 socketControlMessageGetSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_control_message_get_size _obj' touchManagedPtr _obj return result -- method SocketControlMessage::serialize -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketControlMessage", 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 "Gio" "SocketControlMessage", 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_socket_control_message_serialize" g_socket_control_message_serialize :: Ptr SocketControlMessage -> -- _obj : TInterface "Gio" "SocketControlMessage" Ptr () -> -- data : TBasicType TVoid IO () socketControlMessageSerialize :: (MonadIO m, SocketControlMessageK a) => a -> -- _obj Ptr () -> -- data m () socketControlMessageSerialize _obj data_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_control_message_serialize _obj' data_ touchManagedPtr _obj return () -- method SocketControlMessage::deserialize -- method type : MemberFunction -- Args : [Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TInt32, 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},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TInt32, 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 : TInterface "Gio" "SocketControlMessage" -- throws : False -- Skip return : False foreign import ccall "g_socket_control_message_deserialize" g_socket_control_message_deserialize :: Int32 -> -- level : TBasicType TInt32 Int32 -> -- type : TBasicType TInt32 Word64 -> -- size : TBasicType TUInt64 Ptr Word8 -> -- data : TCArray False (-1) 2 (TBasicType TUInt8) IO (Ptr SocketControlMessage) socketControlMessageDeserialize :: (MonadIO m) => Int32 -> -- level Int32 -> -- type ByteString -> -- data m SocketControlMessage socketControlMessageDeserialize level type_ data_ = liftIO $ do let size = fromIntegral $ B.length data_ data_' <- packByteString data_ result <- g_socket_control_message_deserialize level type_ size data_' checkUnexpectedReturnNULL "g_socket_control_message_deserialize" result result' <- (wrapObject SocketControlMessage) result freeMem data_' return result' -- Enum SocketFamily data SocketFamily = SocketFamilyInvalid | SocketFamilyUnix | SocketFamilyIpv4 | SocketFamilyIpv6 | AnotherSocketFamily Int deriving (Show, Eq) instance Enum SocketFamily where fromEnum SocketFamilyInvalid = 0 fromEnum SocketFamilyUnix = 1 fromEnum SocketFamilyIpv4 = 2 fromEnum SocketFamilyIpv6 = 10 fromEnum (AnotherSocketFamily k) = k toEnum 0 = SocketFamilyInvalid toEnum 1 = SocketFamilyUnix toEnum 2 = SocketFamilyIpv4 toEnum 10 = SocketFamilyIpv6 toEnum k = AnotherSocketFamily k foreign import ccall "g_socket_family_get_type" c_g_socket_family_get_type :: IO GType instance BoxedEnum SocketFamily where boxedEnumType _ = c_g_socket_family_get_type -- object SocketListener newtype SocketListener = SocketListener (ForeignPtr SocketListener) noSocketListener :: Maybe SocketListener noSocketListener = Nothing foreign import ccall "g_socket_listener_get_type" c_g_socket_listener_get_type :: IO GType type instance ParentTypes SocketListener = '[GObject.Object] instance GObject SocketListener where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_listener_get_type class GObject o => SocketListenerK o instance (GObject o, IsDescendantOf SocketListener o) => SocketListenerK o toSocketListener :: SocketListenerK o => o -> IO SocketListener toSocketListener = unsafeCastTo SocketListener -- method SocketListener::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "SocketListener" -- throws : False -- Skip return : False foreign import ccall "g_socket_listener_new" g_socket_listener_new :: IO (Ptr SocketListener) socketListenerNew :: (MonadIO m) => m SocketListener socketListenerNew = liftIO $ do result <- g_socket_listener_new checkUnexpectedReturnNULL "g_socket_listener_new" result result' <- (wrapObject SocketListener) result return result' -- method SocketListener::accept -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_listener_accept" g_socket_listener_accept :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr (Ptr GObject.Object) -> -- source_object : TInterface "GObject" "Object" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketListenerAccept :: (MonadIO m, SocketListenerK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m (SocketConnection,GObject.Object) socketListenerAccept _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj source_object <- allocMem :: IO (Ptr (Ptr GObject.Object)) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_listener_accept _obj' source_object maybeCancellable checkUnexpectedReturnNULL "g_socket_listener_accept" result result' <- (wrapObject SocketConnection) result source_object' <- peek source_object source_object'' <- (newObject GObject.Object) source_object' touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem source_object return (result', source_object'') ) (do freeMem source_object ) -- method SocketListener::accept_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_listener_accept_async" g_socket_listener_accept_async :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () socketListenerAcceptAsync :: (MonadIO m, SocketListenerK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () socketListenerAcceptAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_socket_listener_accept_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method SocketListener::accept_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnection" -- throws : True -- Skip return : False foreign import ccall "g_socket_listener_accept_finish" g_socket_listener_accept_finish :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GObject.Object) -> -- source_object : TInterface "GObject" "Object" Ptr (Ptr GError) -> -- error IO (Ptr SocketConnection) socketListenerAcceptFinish :: (MonadIO m, SocketListenerK a, AsyncResultK b) => a -> -- _obj b -> -- result m (SocketConnection,GObject.Object) socketListenerAcceptFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ source_object <- allocMem :: IO (Ptr (Ptr GObject.Object)) onException (do result <- propagateGError $ g_socket_listener_accept_finish _obj' result_' source_object checkUnexpectedReturnNULL "g_socket_listener_accept_finish" result result' <- (wrapObject SocketConnection) result source_object' <- peek source_object source_object'' <- (newObject GObject.Object) source_object' touchManagedPtr _obj touchManagedPtr result_ freeMem source_object return (result', source_object'') ) (do freeMem source_object ) -- method SocketListener::accept_socket -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Socket" -- throws : True -- Skip return : False foreign import ccall "g_socket_listener_accept_socket" g_socket_listener_accept_socket :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr (Ptr GObject.Object) -> -- source_object : TInterface "GObject" "Object" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr Socket) socketListenerAcceptSocket :: (MonadIO m, SocketListenerK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m (Socket,GObject.Object) socketListenerAcceptSocket _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj source_object <- allocMem :: IO (Ptr (Ptr GObject.Object)) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_socket_listener_accept_socket _obj' source_object maybeCancellable checkUnexpectedReturnNULL "g_socket_listener_accept_socket" result result' <- (wrapObject Socket) result source_object' <- peek source_object source_object'' <- (newObject GObject.Object) source_object' touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem source_object return (result', source_object'') ) (do freeMem source_object ) -- method SocketListener::accept_socket_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_listener_accept_socket_async" g_socket_listener_accept_socket_async :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () socketListenerAcceptSocketAsync :: (MonadIO m, SocketListenerK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () socketListenerAcceptSocketAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_socket_listener_accept_socket_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method SocketListener::accept_socket_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Socket" -- throws : True -- Skip return : False foreign import ccall "g_socket_listener_accept_socket_finish" g_socket_listener_accept_socket_finish :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GObject.Object) -> -- source_object : TInterface "GObject" "Object" Ptr (Ptr GError) -> -- error IO (Ptr Socket) socketListenerAcceptSocketFinish :: (MonadIO m, SocketListenerK a, AsyncResultK b) => a -> -- _obj b -> -- result m (Socket,GObject.Object) socketListenerAcceptSocketFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ source_object <- allocMem :: IO (Ptr (Ptr GObject.Object)) onException (do result <- propagateGError $ g_socket_listener_accept_socket_finish _obj' result_' source_object checkUnexpectedReturnNULL "g_socket_listener_accept_socket_finish" result result' <- (wrapObject Socket) result source_object' <- peek source_object source_object'' <- (newObject GObject.Object) source_object' touchManagedPtr _obj touchManagedPtr result_ freeMem source_object return (result', source_object'') ) (do freeMem source_object ) -- method SocketListener::add_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TInterface "Gio" "SocketProtocol", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "effective_address", argType = TInterface "Gio" "SocketAddress", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "address", argType = TInterface "Gio" "SocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "SocketType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "protocol", argType = TInterface "Gio" "SocketProtocol", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_listener_add_address" g_socket_listener_add_address :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr SocketAddress -> -- address : TInterface "Gio" "SocketAddress" CUInt -> -- type : TInterface "Gio" "SocketType" CUInt -> -- protocol : TInterface "Gio" "SocketProtocol" Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" Ptr (Ptr SocketAddress) -> -- effective_address : TInterface "Gio" "SocketAddress" Ptr (Ptr GError) -> -- error IO CInt socketListenerAddAddress :: (MonadIO m, SocketListenerK a, SocketAddressK b, GObject.ObjectK c) => a -> -- _obj b -> -- address SocketType -> -- type SocketProtocol -> -- protocol Maybe (c) -> -- source_object m (SocketAddress) socketListenerAddAddress _obj address type_ protocol source_object = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let address' = unsafeManagedPtrCastPtr address let type_' = (fromIntegral . fromEnum) type_ let protocol' = (fromIntegral . fromEnum) protocol maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' effective_address <- allocMem :: IO (Ptr (Ptr SocketAddress)) onException (do _ <- propagateGError $ g_socket_listener_add_address _obj' address' type_' protocol' maybeSource_object effective_address effective_address' <- peek effective_address effective_address'' <- (wrapObject SocketAddress) effective_address' touchManagedPtr _obj touchManagedPtr address whenJust source_object touchManagedPtr freeMem effective_address return effective_address'' ) (do freeMem effective_address ) -- method SocketListener::add_any_inet_port -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : True -- Skip return : False foreign import ccall "g_socket_listener_add_any_inet_port" g_socket_listener_add_any_inet_port :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" Ptr (Ptr GError) -> -- error IO Word16 socketListenerAddAnyInetPort :: (MonadIO m, SocketListenerK a, GObject.ObjectK b) => a -> -- _obj Maybe (b) -> -- source_object m Word16 socketListenerAddAnyInetPort _obj source_object = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' onException (do result <- propagateGError $ g_socket_listener_add_any_inet_port _obj' maybeSource_object touchManagedPtr _obj whenJust source_object touchManagedPtr return result ) (do return () ) -- method SocketListener::add_inet_port -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_listener_add_inet_port" g_socket_listener_add_inet_port :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Word16 -> -- port : TBasicType TUInt16 Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" Ptr (Ptr GError) -> -- error IO CInt socketListenerAddInetPort :: (MonadIO m, SocketListenerK a, GObject.ObjectK b) => a -> -- _obj Word16 -> -- port Maybe (b) -> -- source_object m () socketListenerAddInetPort _obj port source_object = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' onException (do _ <- propagateGError $ g_socket_listener_add_inet_port _obj' port maybeSource_object touchManagedPtr _obj whenJust source_object touchManagedPtr return () ) (do return () ) -- method SocketListener::add_socket -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "socket", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "socket", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_socket_listener_add_socket" g_socket_listener_add_socket :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Ptr Socket -> -- socket : TInterface "Gio" "Socket" Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" Ptr (Ptr GError) -> -- error IO CInt socketListenerAddSocket :: (MonadIO m, SocketListenerK a, SocketK b, GObject.ObjectK c) => a -> -- _obj b -> -- socket Maybe (c) -> -- source_object m () socketListenerAddSocket _obj socket source_object = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let socket' = unsafeManagedPtrCastPtr socket maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' onException (do _ <- propagateGError $ g_socket_listener_add_socket _obj' socket' maybeSource_object touchManagedPtr _obj touchManagedPtr socket whenJust source_object touchManagedPtr return () ) (do return () ) -- method SocketListener::close -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_listener_close" g_socket_listener_close :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" IO () socketListenerClose :: (MonadIO m, SocketListenerK a) => a -> -- _obj m () socketListenerClose _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_listener_close _obj' touchManagedPtr _obj return () -- method SocketListener::set_backlog -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "listen_backlog", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketListener", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "listen_backlog", 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_socket_listener_set_backlog" g_socket_listener_set_backlog :: Ptr SocketListener -> -- _obj : TInterface "Gio" "SocketListener" Int32 -> -- listen_backlog : TBasicType TInt32 IO () socketListenerSetBacklog :: (MonadIO m, SocketListenerK a) => a -> -- _obj Int32 -> -- listen_backlog m () socketListenerSetBacklog _obj listen_backlog = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_listener_set_backlog _obj' listen_backlog touchManagedPtr _obj return () -- Flags SocketMsgFlags data SocketMsgFlags = SocketMsgFlagsNone | SocketMsgFlagsOob | SocketMsgFlagsPeek | SocketMsgFlagsDontroute | AnotherSocketMsgFlags Int deriving (Show, Eq) instance Enum SocketMsgFlags where fromEnum SocketMsgFlagsNone = 0 fromEnum SocketMsgFlagsOob = 1 fromEnum SocketMsgFlagsPeek = 2 fromEnum SocketMsgFlagsDontroute = 4 fromEnum (AnotherSocketMsgFlags k) = k toEnum 0 = SocketMsgFlagsNone toEnum 1 = SocketMsgFlagsOob toEnum 2 = SocketMsgFlagsPeek toEnum 4 = SocketMsgFlagsDontroute toEnum k = AnotherSocketMsgFlags k foreign import ccall "g_socket_msg_flags_get_type" c_g_socket_msg_flags_get_type :: IO GType instance BoxedEnum SocketMsgFlags where boxedEnumType _ = c_g_socket_msg_flags_get_type instance IsGFlag SocketMsgFlags -- Enum SocketProtocol data SocketProtocol = SocketProtocolUnknown | SocketProtocolDefault | SocketProtocolTcp | SocketProtocolUdp | SocketProtocolSctp | AnotherSocketProtocol Int deriving (Show, Eq) instance Enum SocketProtocol where fromEnum SocketProtocolUnknown = -1 fromEnum SocketProtocolDefault = 0 fromEnum SocketProtocolTcp = 6 fromEnum SocketProtocolUdp = 17 fromEnum SocketProtocolSctp = 132 fromEnum (AnotherSocketProtocol k) = k toEnum -1 = SocketProtocolUnknown toEnum 0 = SocketProtocolDefault toEnum 6 = SocketProtocolTcp toEnum 17 = SocketProtocolUdp toEnum 132 = SocketProtocolSctp toEnum k = AnotherSocketProtocol k foreign import ccall "g_socket_protocol_get_type" c_g_socket_protocol_get_type :: IO GType instance BoxedEnum SocketProtocol where boxedEnumType _ = c_g_socket_protocol_get_type -- object SocketService newtype SocketService = SocketService (ForeignPtr SocketService) noSocketService :: Maybe SocketService noSocketService = Nothing foreign import ccall "g_socket_service_get_type" c_g_socket_service_get_type :: IO GType type instance ParentTypes SocketService = '[SocketListener, GObject.Object] instance GObject SocketService where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_socket_service_get_type class GObject o => SocketServiceK o instance (GObject o, IsDescendantOf SocketService o) => SocketServiceK o toSocketService :: SocketServiceK o => o -> IO SocketService toSocketService = unsafeCastTo SocketService -- method SocketService::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "SocketService" -- throws : False -- Skip return : False foreign import ccall "g_socket_service_new" g_socket_service_new :: IO (Ptr SocketService) socketServiceNew :: (MonadIO m) => m SocketService socketServiceNew = liftIO $ do result <- g_socket_service_new checkUnexpectedReturnNULL "g_socket_service_new" result result' <- (wrapObject SocketService) result return result' -- method SocketService::is_active -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_socket_service_is_active" g_socket_service_is_active :: Ptr SocketService -> -- _obj : TInterface "Gio" "SocketService" IO CInt socketServiceIsActive :: (MonadIO m, SocketServiceK a) => a -> -- _obj m Bool socketServiceIsActive _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_socket_service_is_active _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method SocketService::start -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_service_start" g_socket_service_start :: Ptr SocketService -> -- _obj : TInterface "Gio" "SocketService" IO () socketServiceStart :: (MonadIO m, SocketServiceK a) => a -> -- _obj m () socketServiceStart _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_service_start _obj' touchManagedPtr _obj return () -- method SocketService::stop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SocketService", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_socket_service_stop" g_socket_service_stop :: Ptr SocketService -> -- _obj : TInterface "Gio" "SocketService" IO () socketServiceStop :: (MonadIO m, SocketServiceK a) => a -> -- _obj m () socketServiceStop _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_socket_service_stop _obj' touchManagedPtr _obj return () -- signal SocketService::incoming type SocketServiceIncomingCallback = SocketConnection -> Maybe GObject.Object -> IO Bool noSocketServiceIncomingCallback :: Maybe SocketServiceIncomingCallback noSocketServiceIncomingCallback = Nothing type SocketServiceIncomingCallbackC = Ptr () -> -- object Ptr SocketConnection -> Ptr GObject.Object -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkSocketServiceIncomingCallback :: SocketServiceIncomingCallbackC -> IO (FunPtr SocketServiceIncomingCallbackC) socketServiceIncomingClosure :: SocketServiceIncomingCallback -> IO Closure socketServiceIncomingClosure cb = newCClosure =<< mkSocketServiceIncomingCallback wrapped where wrapped = socketServiceIncomingCallbackWrapper cb socketServiceIncomingCallbackWrapper :: SocketServiceIncomingCallback -> Ptr () -> Ptr SocketConnection -> Ptr GObject.Object -> Ptr () -> IO CInt socketServiceIncomingCallbackWrapper _cb _ connection source_object _ = do connection' <- (newObject SocketConnection) connection maybeSource_object <- if source_object == nullPtr then return Nothing else do source_object' <- (newObject GObject.Object) source_object return $ Just source_object' result <- _cb connection' maybeSource_object let result' = (fromIntegral . fromEnum) result return result' onSocketServiceIncoming :: (GObject a, MonadIO m) => a -> SocketServiceIncomingCallback -> m SignalHandlerId onSocketServiceIncoming obj cb = liftIO $ connectSocketServiceIncoming obj cb SignalConnectBefore afterSocketServiceIncoming :: (GObject a, MonadIO m) => a -> SocketServiceIncomingCallback -> m SignalHandlerId afterSocketServiceIncoming obj cb = connectSocketServiceIncoming obj cb SignalConnectAfter connectSocketServiceIncoming :: (GObject a, MonadIO m) => a -> SocketServiceIncomingCallback -> SignalConnectMode -> m SignalHandlerId connectSocketServiceIncoming obj cb after = liftIO $ do cb' <- mkSocketServiceIncomingCallback (socketServiceIncomingCallbackWrapper cb) connectSignalFunPtr obj "incoming" cb' after -- callback SocketSourceFunc socketSourceFuncClosure :: SocketSourceFunc -> IO Closure socketSourceFuncClosure cb = newCClosure =<< mkSocketSourceFunc wrapped where wrapped = socketSourceFuncWrapper Nothing cb type SocketSourceFuncC = Ptr Socket -> CUInt -> Ptr () -> IO CInt foreign import ccall "wrapper" mkSocketSourceFunc :: SocketSourceFuncC -> IO (FunPtr SocketSourceFuncC) type SocketSourceFunc = Socket -> [GLib.IOCondition] -> IO Bool noSocketSourceFunc :: Maybe SocketSourceFunc noSocketSourceFunc = Nothing socketSourceFuncWrapper :: Maybe (Ptr (FunPtr (SocketSourceFuncC))) -> SocketSourceFunc -> Ptr Socket -> CUInt -> Ptr () -> IO CInt socketSourceFuncWrapper funptrptr _cb socket condition _ = do socket' <- (newObject Socket) socket let condition' = wordToGFlags condition result <- _cb socket' condition' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Enum SocketType data SocketType = SocketTypeInvalid | SocketTypeStream | SocketTypeDatagram | SocketTypeSeqpacket | AnotherSocketType Int deriving (Show, Eq) instance Enum SocketType where fromEnum SocketTypeInvalid = 0 fromEnum SocketTypeStream = 1 fromEnum SocketTypeDatagram = 2 fromEnum SocketTypeSeqpacket = 3 fromEnum (AnotherSocketType k) = k toEnum 0 = SocketTypeInvalid toEnum 1 = SocketTypeStream toEnum 2 = SocketTypeDatagram toEnum 3 = SocketTypeSeqpacket toEnum k = AnotherSocketType k foreign import ccall "g_socket_type_get_type" c_g_socket_type_get_type :: IO GType instance BoxedEnum SocketType where boxedEnumType _ = c_g_socket_type_get_type -- struct SrvTarget newtype SrvTarget = SrvTarget (ForeignPtr SrvTarget) noSrvTarget :: Maybe SrvTarget noSrvTarget = Nothing foreign import ccall "g_srv_target_get_type" c_g_srv_target_get_type :: IO GType instance BoxedObject SrvTarget where boxedType _ = c_g_srv_target_get_type -- method SrvTarget::new -- method type : Constructor -- Args : [Arg {argName = "hostname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "weight", argType = TBasicType TUInt16, 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},Arg {argName = "port", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "priority", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "weight", argType = TBasicType TUInt16, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SrvTarget" -- throws : False -- Skip return : False foreign import ccall "g_srv_target_new" g_srv_target_new :: CString -> -- hostname : TBasicType TUTF8 Word16 -> -- port : TBasicType TUInt16 Word16 -> -- priority : TBasicType TUInt16 Word16 -> -- weight : TBasicType TUInt16 IO (Ptr SrvTarget) srvTargetNew :: (MonadIO m) => T.Text -> -- hostname Word16 -> -- port Word16 -> -- priority Word16 -> -- weight m SrvTarget srvTargetNew hostname port priority weight = liftIO $ do hostname' <- textToCString hostname result <- g_srv_target_new hostname' port priority weight checkUnexpectedReturnNULL "g_srv_target_new" result result' <- (wrapBoxed SrvTarget) result freeMem hostname' return result' -- method SrvTarget::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SrvTarget" -- throws : False -- Skip return : False foreign import ccall "g_srv_target_copy" g_srv_target_copy :: Ptr SrvTarget -> -- _obj : TInterface "Gio" "SrvTarget" IO (Ptr SrvTarget) srvTargetCopy :: (MonadIO m) => SrvTarget -> -- _obj m SrvTarget srvTargetCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_srv_target_copy _obj' checkUnexpectedReturnNULL "g_srv_target_copy" result result' <- (wrapBoxed SrvTarget) result touchManagedPtr _obj return result' -- method SrvTarget::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_srv_target_free" g_srv_target_free :: Ptr SrvTarget -> -- _obj : TInterface "Gio" "SrvTarget" IO () srvTargetFree :: (MonadIO m) => SrvTarget -> -- _obj m () srvTargetFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_srv_target_free _obj' touchManagedPtr _obj return () -- method SrvTarget::get_hostname -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_srv_target_get_hostname" g_srv_target_get_hostname :: Ptr SrvTarget -> -- _obj : TInterface "Gio" "SrvTarget" IO CString srvTargetGetHostname :: (MonadIO m) => SrvTarget -> -- _obj m T.Text srvTargetGetHostname _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_srv_target_get_hostname _obj' checkUnexpectedReturnNULL "g_srv_target_get_hostname" result result' <- cstringToText result touchManagedPtr _obj return result' -- method SrvTarget::get_port -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "g_srv_target_get_port" g_srv_target_get_port :: Ptr SrvTarget -> -- _obj : TInterface "Gio" "SrvTarget" IO Word16 srvTargetGetPort :: (MonadIO m) => SrvTarget -> -- _obj m Word16 srvTargetGetPort _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_srv_target_get_port _obj' touchManagedPtr _obj return result -- method SrvTarget::get_priority -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "g_srv_target_get_priority" g_srv_target_get_priority :: Ptr SrvTarget -> -- _obj : TInterface "Gio" "SrvTarget" IO Word16 srvTargetGetPriority :: (MonadIO m) => SrvTarget -> -- _obj m Word16 srvTargetGetPriority _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_srv_target_get_priority _obj' touchManagedPtr _obj return result -- method SrvTarget::get_weight -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SrvTarget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "g_srv_target_get_weight" g_srv_target_get_weight :: Ptr SrvTarget -> -- _obj : TInterface "Gio" "SrvTarget" IO Word16 srvTargetGetWeight :: (MonadIO m) => SrvTarget -> -- _obj m Word16 srvTargetGetWeight _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_srv_target_get_weight _obj' touchManagedPtr _obj return result -- struct StaticResource newtype StaticResource = StaticResource (ForeignPtr StaticResource) noStaticResource :: Maybe StaticResource noStaticResource = Nothing -- method StaticResource::fini -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "StaticResource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "StaticResource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_static_resource_fini" g_static_resource_fini :: Ptr StaticResource -> -- _obj : TInterface "Gio" "StaticResource" IO () staticResourceFini :: (MonadIO m) => StaticResource -> -- _obj m () staticResourceFini _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_static_resource_fini _obj' touchManagedPtr _obj return () -- method StaticResource::get_resource -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "StaticResource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "StaticResource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Resource" -- throws : False -- Skip return : False foreign import ccall "g_static_resource_get_resource" g_static_resource_get_resource :: Ptr StaticResource -> -- _obj : TInterface "Gio" "StaticResource" IO (Ptr Resource) staticResourceGetResource :: (MonadIO m) => StaticResource -> -- _obj m Resource staticResourceGetResource _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_static_resource_get_resource _obj' checkUnexpectedReturnNULL "g_static_resource_get_resource" result result' <- (newBoxed Resource) result touchManagedPtr _obj return result' -- method StaticResource::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "StaticResource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "StaticResource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_static_resource_init" g_static_resource_init :: Ptr StaticResource -> -- _obj : TInterface "Gio" "StaticResource" IO () staticResourceInit :: (MonadIO m) => StaticResource -> -- _obj m () staticResourceInit _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_static_resource_init _obj' touchManagedPtr _obj return () -- object Subprocess newtype Subprocess = Subprocess (ForeignPtr Subprocess) noSubprocess :: Maybe Subprocess noSubprocess = Nothing foreign import ccall "g_subprocess_get_type" c_g_subprocess_get_type :: IO GType type instance ParentTypes Subprocess = '[GObject.Object, Initable] instance GObject Subprocess where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_subprocess_get_type class GObject o => SubprocessK o instance (GObject o, IsDescendantOf Subprocess o) => SubprocessK o toSubprocess :: SubprocessK o => o -> IO Subprocess toSubprocess = unsafeCastTo Subprocess -- method Subprocess::new -- method type : Constructor -- Args : [Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "SubprocessFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "SubprocessFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Subprocess" -- throws : True -- Skip return : False foreign import ccall "g_subprocess_newv" g_subprocess_newv :: Ptr CString -> -- argv : TCArray True (-1) (-1) (TBasicType TUTF8) CUInt -> -- flags : TInterface "Gio" "SubprocessFlags" Ptr (Ptr GError) -> -- error IO (Ptr Subprocess) subprocessNew :: (MonadIO m) => [T.Text] -> -- argv [SubprocessFlags] -> -- flags m Subprocess subprocessNew argv flags = liftIO $ do argv' <- packZeroTerminatedUTF8CArray argv let flags' = gflagsToWord flags onException (do result <- propagateGError $ g_subprocess_newv argv' flags' checkUnexpectedReturnNULL "g_subprocess_newv" result result' <- (wrapObject Subprocess) result mapZeroTerminatedCArray freeMem argv' freeMem argv' return result' ) (do mapZeroTerminatedCArray freeMem argv' freeMem argv' ) -- method Subprocess::communicate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdin_buf", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdout_buf", argType = TInterface "GLib" "Bytes", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "stderr_buf", argType = TInterface "GLib" "Bytes", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdin_buf", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_subprocess_communicate" g_subprocess_communicate :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr GLib.Bytes -> -- stdin_buf : TInterface "GLib" "Bytes" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GLib.Bytes) -> -- stdout_buf : TInterface "GLib" "Bytes" Ptr (Ptr GLib.Bytes) -> -- stderr_buf : TInterface "GLib" "Bytes" Ptr (Ptr GError) -> -- error IO CInt subprocessCommunicate :: (MonadIO m, SubprocessK a, CancellableK b) => a -> -- _obj Maybe (GLib.Bytes) -> -- stdin_buf Maybe (b) -> -- cancellable m (GLib.Bytes,GLib.Bytes) subprocessCommunicate _obj stdin_buf cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeStdin_buf <- case stdin_buf of Nothing -> return nullPtr Just jStdin_buf -> do let jStdin_buf' = unsafeManagedPtrGetPtr jStdin_buf return jStdin_buf' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' stdout_buf <- allocMem :: IO (Ptr (Ptr GLib.Bytes)) stderr_buf <- allocMem :: IO (Ptr (Ptr GLib.Bytes)) onException (do _ <- propagateGError $ g_subprocess_communicate _obj' maybeStdin_buf maybeCancellable stdout_buf stderr_buf stdout_buf' <- peek stdout_buf stdout_buf'' <- (wrapBoxed GLib.Bytes) stdout_buf' stderr_buf' <- peek stderr_buf stderr_buf'' <- (wrapBoxed GLib.Bytes) stderr_buf' touchManagedPtr _obj whenJust stdin_buf touchManagedPtr whenJust cancellable touchManagedPtr freeMem stdout_buf freeMem stderr_buf return (stdout_buf'', stderr_buf'') ) (do freeMem stdout_buf freeMem stderr_buf ) -- method Subprocess::communicate_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdin_buf", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdin_buf", argType = TInterface "GLib" "Bytes", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_communicate_async" g_subprocess_communicate_async :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr GLib.Bytes -> -- stdin_buf : TInterface "GLib" "Bytes" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () subprocessCommunicateAsync :: (MonadIO m, SubprocessK a, CancellableK b) => a -> -- _obj Maybe (GLib.Bytes) -> -- stdin_buf Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () subprocessCommunicateAsync _obj stdin_buf cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeStdin_buf <- case stdin_buf of Nothing -> return nullPtr Just jStdin_buf -> do let jStdin_buf' = unsafeManagedPtrGetPtr jStdin_buf return jStdin_buf' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_subprocess_communicate_async _obj' maybeStdin_buf maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust stdin_buf touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Subprocess::communicate_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdout_buf", argType = TInterface "GLib" "Bytes", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "stderr_buf", argType = TInterface "GLib" "Bytes", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_subprocess_communicate_finish" g_subprocess_communicate_finish :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GLib.Bytes) -> -- stdout_buf : TInterface "GLib" "Bytes" Ptr (Ptr GLib.Bytes) -> -- stderr_buf : TInterface "GLib" "Bytes" Ptr (Ptr GError) -> -- error IO CInt subprocessCommunicateFinish :: (MonadIO m, SubprocessK a, AsyncResultK b) => a -> -- _obj b -> -- result m (GLib.Bytes,GLib.Bytes) subprocessCommunicateFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ stdout_buf <- allocMem :: IO (Ptr (Ptr GLib.Bytes)) stderr_buf <- allocMem :: IO (Ptr (Ptr GLib.Bytes)) onException (do _ <- propagateGError $ g_subprocess_communicate_finish _obj' result_' stdout_buf stderr_buf stdout_buf' <- peek stdout_buf stdout_buf'' <- (wrapBoxed GLib.Bytes) stdout_buf' stderr_buf' <- peek stderr_buf stderr_buf'' <- (wrapBoxed GLib.Bytes) stderr_buf' touchManagedPtr _obj touchManagedPtr result_ freeMem stdout_buf freeMem stderr_buf return (stdout_buf'', stderr_buf'') ) (do freeMem stdout_buf freeMem stderr_buf ) -- method Subprocess::communicate_utf8 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdin_buf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdout_buf", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "stderr_buf", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdin_buf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_subprocess_communicate_utf8" g_subprocess_communicate_utf8 :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" CString -> -- stdin_buf : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr CString -> -- stdout_buf : TBasicType TUTF8 Ptr CString -> -- stderr_buf : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt subprocessCommunicateUtf8 :: (MonadIO m, SubprocessK a, CancellableK b) => a -> -- _obj Maybe (T.Text) -> -- stdin_buf Maybe (b) -> -- cancellable m (T.Text,T.Text) subprocessCommunicateUtf8 _obj stdin_buf cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeStdin_buf <- case stdin_buf of Nothing -> return nullPtr Just jStdin_buf -> do jStdin_buf' <- textToCString jStdin_buf return jStdin_buf' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' stdout_buf <- allocMem :: IO (Ptr CString) stderr_buf <- allocMem :: IO (Ptr CString) onException (do _ <- propagateGError $ g_subprocess_communicate_utf8 _obj' maybeStdin_buf maybeCancellable stdout_buf stderr_buf stdout_buf' <- peek stdout_buf stdout_buf'' <- cstringToText stdout_buf' freeMem stdout_buf' stderr_buf' <- peek stderr_buf stderr_buf'' <- cstringToText stderr_buf' freeMem stderr_buf' touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem maybeStdin_buf freeMem stdout_buf freeMem stderr_buf return (stdout_buf'', stderr_buf'') ) (do freeMem maybeStdin_buf freeMem stdout_buf freeMem stderr_buf ) -- method Subprocess::communicate_utf8_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdin_buf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdin_buf", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_communicate_utf8_async" g_subprocess_communicate_utf8_async :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" CString -> -- stdin_buf : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () subprocessCommunicateUtf8Async :: (MonadIO m, SubprocessK a, CancellableK b) => a -> -- _obj Maybe (T.Text) -> -- stdin_buf Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () subprocessCommunicateUtf8Async _obj stdin_buf cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeStdin_buf <- case stdin_buf of Nothing -> return nullPtr Just jStdin_buf -> do jStdin_buf' <- textToCString jStdin_buf return jStdin_buf' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_subprocess_communicate_utf8_async _obj' maybeStdin_buf maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr freeMem maybeStdin_buf return () -- method Subprocess::communicate_utf8_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stdout_buf", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "stderr_buf", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_subprocess_communicate_utf8_finish" g_subprocess_communicate_utf8_finish :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr CString -> -- stdout_buf : TBasicType TUTF8 Ptr CString -> -- stderr_buf : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt subprocessCommunicateUtf8Finish :: (MonadIO m, SubprocessK a, AsyncResultK b) => a -> -- _obj b -> -- result m (T.Text,T.Text) subprocessCommunicateUtf8Finish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ stdout_buf <- allocMem :: IO (Ptr CString) stderr_buf <- allocMem :: IO (Ptr CString) onException (do _ <- propagateGError $ g_subprocess_communicate_utf8_finish _obj' result_' stdout_buf stderr_buf stdout_buf' <- peek stdout_buf stdout_buf'' <- cstringToText stdout_buf' freeMem stdout_buf' stderr_buf' <- peek stderr_buf stderr_buf'' <- cstringToText stderr_buf' freeMem stderr_buf' touchManagedPtr _obj touchManagedPtr result_ freeMem stdout_buf freeMem stderr_buf return (stdout_buf'', stderr_buf'') ) (do freeMem stdout_buf freeMem stderr_buf ) -- method Subprocess::force_exit -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_force_exit" g_subprocess_force_exit :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO () subprocessForceExit :: (MonadIO m, SubprocessK a) => a -> -- _obj m () subprocessForceExit _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_subprocess_force_exit _obj' touchManagedPtr _obj return () -- method Subprocess::get_exit_status -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_exit_status" g_subprocess_get_exit_status :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO Int32 subprocessGetExitStatus :: (MonadIO m, SubprocessK a) => a -> -- _obj m Int32 subprocessGetExitStatus _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_exit_status _obj' touchManagedPtr _obj return result -- method Subprocess::get_identifier -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_identifier" g_subprocess_get_identifier :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO CString subprocessGetIdentifier :: (MonadIO m, SubprocessK a) => a -> -- _obj m T.Text subprocessGetIdentifier _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_identifier _obj' checkUnexpectedReturnNULL "g_subprocess_get_identifier" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Subprocess::get_if_exited -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_if_exited" g_subprocess_get_if_exited :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO CInt subprocessGetIfExited :: (MonadIO m, SubprocessK a) => a -> -- _obj m Bool subprocessGetIfExited _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_if_exited _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Subprocess::get_if_signaled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_if_signaled" g_subprocess_get_if_signaled :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO CInt subprocessGetIfSignaled :: (MonadIO m, SubprocessK a) => a -> -- _obj m Bool subprocessGetIfSignaled _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_if_signaled _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Subprocess::get_status -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_status" g_subprocess_get_status :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO Int32 subprocessGetStatus :: (MonadIO m, SubprocessK a) => a -> -- _obj m Int32 subprocessGetStatus _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_status _obj' touchManagedPtr _obj return result -- method Subprocess::get_stderr_pipe -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_stderr_pipe" g_subprocess_get_stderr_pipe :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO (Ptr InputStream) subprocessGetStderrPipe :: (MonadIO m, SubprocessK a) => a -> -- _obj m InputStream subprocessGetStderrPipe _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_stderr_pipe _obj' checkUnexpectedReturnNULL "g_subprocess_get_stderr_pipe" result result' <- (newObject InputStream) result touchManagedPtr _obj return result' -- method Subprocess::get_stdin_pipe -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "OutputStream" -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_stdin_pipe" g_subprocess_get_stdin_pipe :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO (Ptr OutputStream) subprocessGetStdinPipe :: (MonadIO m, SubprocessK a) => a -> -- _obj m OutputStream subprocessGetStdinPipe _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_stdin_pipe _obj' checkUnexpectedReturnNULL "g_subprocess_get_stdin_pipe" result result' <- (newObject OutputStream) result touchManagedPtr _obj return result' -- method Subprocess::get_stdout_pipe -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_stdout_pipe" g_subprocess_get_stdout_pipe :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO (Ptr InputStream) subprocessGetStdoutPipe :: (MonadIO m, SubprocessK a) => a -> -- _obj m InputStream subprocessGetStdoutPipe _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_stdout_pipe _obj' checkUnexpectedReturnNULL "g_subprocess_get_stdout_pipe" result result' <- (newObject InputStream) result touchManagedPtr _obj return result' -- method Subprocess::get_successful -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_successful" g_subprocess_get_successful :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO CInt subprocessGetSuccessful :: (MonadIO m, SubprocessK a) => a -> -- _obj m Bool subprocessGetSuccessful _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_successful _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Subprocess::get_term_sig -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_subprocess_get_term_sig" g_subprocess_get_term_sig :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" IO Int32 subprocessGetTermSig :: (MonadIO m, SubprocessK a) => a -> -- _obj m Int32 subprocessGetTermSig _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_subprocess_get_term_sig _obj' touchManagedPtr _obj return result -- method Subprocess::send_signal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_num", 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_subprocess_send_signal" g_subprocess_send_signal :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Int32 -> -- signal_num : TBasicType TInt32 IO () subprocessSendSignal :: (MonadIO m, SubprocessK a) => a -> -- _obj Int32 -> -- signal_num m () subprocessSendSignal _obj signal_num = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_subprocess_send_signal _obj' signal_num touchManagedPtr _obj return () -- method Subprocess::wait -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_subprocess_wait" g_subprocess_wait :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt subprocessWait :: (MonadIO m, SubprocessK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () subprocessWait _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_subprocess_wait _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Subprocess::wait_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_wait_async" g_subprocess_wait_async :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () subprocessWaitAsync :: (MonadIO m, SubprocessK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () subprocessWaitAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_subprocess_wait_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Subprocess::wait_check -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_subprocess_wait_check" g_subprocess_wait_check :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt subprocessWaitCheck :: (MonadIO m, SubprocessK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () subprocessWaitCheck _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_subprocess_wait_check _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method Subprocess::wait_check_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_wait_check_async" g_subprocess_wait_check_async :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () subprocessWaitCheckAsync :: (MonadIO m, SubprocessK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () subprocessWaitCheckAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_subprocess_wait_check_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Subprocess::wait_check_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_subprocess_wait_check_finish" g_subprocess_wait_check_finish :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt subprocessWaitCheckFinish :: (MonadIO m, SubprocessK a, AsyncResultK b) => a -> -- _obj b -> -- result m () subprocessWaitCheckFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_subprocess_wait_check_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Subprocess::wait_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Subprocess", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_subprocess_wait_finish" g_subprocess_wait_finish :: Ptr Subprocess -> -- _obj : TInterface "Gio" "Subprocess" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt subprocessWaitFinish :: (MonadIO m, SubprocessK a, AsyncResultK b) => a -> -- _obj b -> -- result m () subprocessWaitFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_subprocess_wait_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- Flags SubprocessFlags data SubprocessFlags = SubprocessFlagsNone | SubprocessFlagsStdinPipe | SubprocessFlagsStdinInherit | SubprocessFlagsStdoutPipe | SubprocessFlagsStdoutSilence | SubprocessFlagsStderrPipe | SubprocessFlagsStderrSilence | SubprocessFlagsStderrMerge | SubprocessFlagsInheritFds | AnotherSubprocessFlags Int deriving (Show, Eq) instance Enum SubprocessFlags where fromEnum SubprocessFlagsNone = 0 fromEnum SubprocessFlagsStdinPipe = 1 fromEnum SubprocessFlagsStdinInherit = 2 fromEnum SubprocessFlagsStdoutPipe = 4 fromEnum SubprocessFlagsStdoutSilence = 8 fromEnum SubprocessFlagsStderrPipe = 16 fromEnum SubprocessFlagsStderrSilence = 32 fromEnum SubprocessFlagsStderrMerge = 64 fromEnum SubprocessFlagsInheritFds = 128 fromEnum (AnotherSubprocessFlags k) = k toEnum 0 = SubprocessFlagsNone toEnum 1 = SubprocessFlagsStdinPipe toEnum 2 = SubprocessFlagsStdinInherit toEnum 4 = SubprocessFlagsStdoutPipe toEnum 8 = SubprocessFlagsStdoutSilence toEnum 16 = SubprocessFlagsStderrPipe toEnum 32 = SubprocessFlagsStderrSilence toEnum 64 = SubprocessFlagsStderrMerge toEnum 128 = SubprocessFlagsInheritFds toEnum k = AnotherSubprocessFlags k foreign import ccall "g_subprocess_flags_get_type" c_g_subprocess_flags_get_type :: IO GType instance BoxedEnum SubprocessFlags where boxedEnumType _ = c_g_subprocess_flags_get_type instance IsGFlag SubprocessFlags -- object SubprocessLauncher newtype SubprocessLauncher = SubprocessLauncher (ForeignPtr SubprocessLauncher) noSubprocessLauncher :: Maybe SubprocessLauncher noSubprocessLauncher = Nothing foreign import ccall "g_subprocess_launcher_get_type" c_g_subprocess_launcher_get_type :: IO GType type instance ParentTypes SubprocessLauncher = '[GObject.Object] instance GObject SubprocessLauncher where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_subprocess_launcher_get_type class GObject o => SubprocessLauncherK o instance (GObject o, IsDescendantOf SubprocessLauncher o) => SubprocessLauncherK o toSubprocessLauncher :: SubprocessLauncherK o => o -> IO SubprocessLauncher toSubprocessLauncher = unsafeCastTo SubprocessLauncher -- method SubprocessLauncher::new -- method type : Constructor -- Args : [Arg {argName = "flags", argType = TInterface "Gio" "SubprocessFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "flags", argType = TInterface "Gio" "SubprocessFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SubprocessLauncher" -- throws : False -- Skip return : False foreign import ccall "g_subprocess_launcher_new" g_subprocess_launcher_new :: CUInt -> -- flags : TInterface "Gio" "SubprocessFlags" IO (Ptr SubprocessLauncher) subprocessLauncherNew :: (MonadIO m) => [SubprocessFlags] -> -- flags m SubprocessLauncher subprocessLauncherNew flags = liftIO $ do let flags' = gflagsToWord flags result <- g_subprocess_launcher_new flags' checkUnexpectedReturnNULL "g_subprocess_launcher_new" result result' <- (wrapObject SubprocessLauncher) result return result' -- method SubprocessLauncher::getenv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, 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 = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, 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_subprocess_launcher_getenv" g_subprocess_launcher_getenv :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CString -> -- variable : TBasicType TUTF8 IO CString subprocessLauncherGetenv :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj T.Text -> -- variable m T.Text subprocessLauncherGetenv _obj variable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj variable' <- textToCString variable result <- g_subprocess_launcher_getenv _obj' variable' checkUnexpectedReturnNULL "g_subprocess_launcher_getenv" result result' <- cstringToText result touchManagedPtr _obj freeMem variable' return result' -- method SubprocessLauncher::set_child_setup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_launcher_set_child_setup" g_subprocess_launcher_set_child_setup :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" FunPtr GLib.SpawnChildSetupFuncC -> -- child_setup : TInterface "GLib" "SpawnChildSetupFunc" Ptr () -> -- user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- destroy_notify : TInterface "GLib" "DestroyNotify" IO () subprocessLauncherSetChildSetup :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj GLib.SpawnChildSetupFunc -> -- child_setup m () subprocessLauncherSetChildSetup _obj child_setup = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj child_setup' <- GLib.mkSpawnChildSetupFunc (GLib.spawnChildSetupFuncWrapper Nothing child_setup) let user_data = castFunPtrToPtr child_setup' let destroy_notify = safeFreeFunPtrPtr g_subprocess_launcher_set_child_setup _obj' child_setup' user_data destroy_notify touchManagedPtr _obj return () -- method SubprocessLauncher::set_cwd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cwd", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cwd", 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_subprocess_launcher_set_cwd" g_subprocess_launcher_set_cwd :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CString -> -- cwd : TBasicType TUTF8 IO () subprocessLauncherSetCwd :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj T.Text -> -- cwd m () subprocessLauncherSetCwd _obj cwd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj cwd' <- textToCString cwd g_subprocess_launcher_set_cwd _obj' cwd' touchManagedPtr _obj freeMem cwd' return () -- method SubprocessLauncher::set_environ -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "env", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "env", 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_subprocess_launcher_set_environ" g_subprocess_launcher_set_environ :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CString -> -- env : TBasicType TUTF8 IO () subprocessLauncherSetEnviron :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj T.Text -> -- env m () subprocessLauncherSetEnviron _obj env = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj env' <- textToCString env g_subprocess_launcher_set_environ _obj' env' touchManagedPtr _obj freeMem env' return () -- method SubprocessLauncher::set_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "SubprocessFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "SubprocessFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_launcher_set_flags" g_subprocess_launcher_set_flags :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CUInt -> -- flags : TInterface "Gio" "SubprocessFlags" IO () subprocessLauncherSetFlags :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj [SubprocessFlags] -> -- flags m () subprocessLauncherSetFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags g_subprocess_launcher_set_flags _obj' flags' touchManagedPtr _obj return () -- method SubprocessLauncher::set_stderr_file_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", 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_subprocess_launcher_set_stderr_file_path" g_subprocess_launcher_set_stderr_file_path :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CString -> -- path : TBasicType TUTF8 IO () subprocessLauncherSetStderrFilePath :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj T.Text -> -- path m () subprocessLauncherSetStderrFilePath _obj path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj path' <- textToCString path g_subprocess_launcher_set_stderr_file_path _obj' path' touchManagedPtr _obj freeMem path' return () -- method SubprocessLauncher::set_stdin_file_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", 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_subprocess_launcher_set_stdin_file_path" g_subprocess_launcher_set_stdin_file_path :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CString -> -- path : TBasicType TUTF8 IO () subprocessLauncherSetStdinFilePath :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj T.Text -> -- path m () subprocessLauncherSetStdinFilePath _obj path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj path' <- textToCString path g_subprocess_launcher_set_stdin_file_path _obj' path' touchManagedPtr _obj freeMem path' return () -- method SubprocessLauncher::set_stdout_file_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", 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_subprocess_launcher_set_stdout_file_path" g_subprocess_launcher_set_stdout_file_path :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CString -> -- path : TBasicType TUTF8 IO () subprocessLauncherSetStdoutFilePath :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj T.Text -> -- path m () subprocessLauncherSetStdoutFilePath _obj path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj path' <- textToCString path g_subprocess_launcher_set_stdout_file_path _obj' path' touchManagedPtr _obj freeMem path' return () -- method SubprocessLauncher::setenv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, 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},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 = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, 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},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 TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_launcher_setenv" g_subprocess_launcher_setenv :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CString -> -- variable : TBasicType TUTF8 CString -> -- value : TBasicType TUTF8 CInt -> -- overwrite : TBasicType TBoolean IO () subprocessLauncherSetenv :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj T.Text -> -- variable T.Text -> -- value Bool -> -- overwrite m () subprocessLauncherSetenv _obj variable value overwrite = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj variable' <- textToCString variable value' <- textToCString value let overwrite' = (fromIntegral . fromEnum) overwrite g_subprocess_launcher_setenv _obj' variable' value' overwrite' touchManagedPtr _obj freeMem variable' freeMem value' return () -- method SubprocessLauncher::spawnv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, 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}] -- returnType : TInterface "Gio" "Subprocess" -- throws : True -- Skip return : False foreign import ccall "g_subprocess_launcher_spawnv" g_subprocess_launcher_spawnv :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" Ptr CString -> -- argv : TCArray True (-1) (-1) (TBasicType TUTF8) Ptr (Ptr GError) -> -- error IO (Ptr Subprocess) subprocessLauncherSpawnv :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj [T.Text] -> -- argv m Subprocess subprocessLauncherSpawnv _obj argv = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj argv' <- packZeroTerminatedUTF8CArray argv onException (do result <- propagateGError $ g_subprocess_launcher_spawnv _obj' argv' checkUnexpectedReturnNULL "g_subprocess_launcher_spawnv" result result' <- (wrapObject Subprocess) result touchManagedPtr _obj mapZeroTerminatedCArray freeMem argv' freeMem argv' return result' ) (do mapZeroTerminatedCArray freeMem argv' freeMem argv' ) -- method SubprocessLauncher::take_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_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_subprocess_launcher_take_fd" g_subprocess_launcher_take_fd :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" Int32 -> -- source_fd : TBasicType TInt32 Int32 -> -- target_fd : TBasicType TInt32 IO () subprocessLauncherTakeFd :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj Int32 -> -- source_fd Int32 -> -- target_fd m () subprocessLauncherTakeFd _obj source_fd target_fd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_subprocess_launcher_take_fd _obj' source_fd target_fd touchManagedPtr _obj return () -- method SubprocessLauncher::take_stderr_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", 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}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_launcher_take_stderr_fd" g_subprocess_launcher_take_stderr_fd :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" Int32 -> -- fd : TBasicType TInt32 IO () subprocessLauncherTakeStderrFd :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj Int32 -> -- fd m () subprocessLauncherTakeStderrFd _obj fd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_subprocess_launcher_take_stderr_fd _obj' fd touchManagedPtr _obj return () -- method SubprocessLauncher::take_stdin_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", 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}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_launcher_take_stdin_fd" g_subprocess_launcher_take_stdin_fd :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" Int32 -> -- fd : TBasicType TInt32 IO () subprocessLauncherTakeStdinFd :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj Int32 -> -- fd m () subprocessLauncherTakeStdinFd _obj fd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_subprocess_launcher_take_stdin_fd _obj' fd touchManagedPtr _obj return () -- method SubprocessLauncher::take_stdout_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", 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}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_launcher_take_stdout_fd" g_subprocess_launcher_take_stdout_fd :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" Int32 -> -- fd : TBasicType TInt32 IO () subprocessLauncherTakeStdoutFd :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj Int32 -> -- fd m () subprocessLauncherTakeStdoutFd _obj fd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_subprocess_launcher_take_stdout_fd _obj' fd touchManagedPtr _obj return () -- method SubprocessLauncher::unsetenv -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, 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 = "_obj", argType = TInterface "Gio" "SubprocessLauncher", direction = DirectionIn, mayBeNull = False, 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 TVoid -- throws : False -- Skip return : False foreign import ccall "g_subprocess_launcher_unsetenv" g_subprocess_launcher_unsetenv :: Ptr SubprocessLauncher -> -- _obj : TInterface "Gio" "SubprocessLauncher" CString -> -- variable : TBasicType TUTF8 IO () subprocessLauncherUnsetenv :: (MonadIO m, SubprocessLauncherK a) => a -> -- _obj T.Text -> -- variable m () subprocessLauncherUnsetenv _obj variable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj variable' <- textToCString variable g_subprocess_launcher_unsetenv _obj' variable' touchManagedPtr _obj freeMem variable' return () -- object Task newtype Task = Task (ForeignPtr Task) noTask :: Maybe Task noTask = Nothing foreign import ccall "g_task_get_type" c_g_task_get_type :: IO GType type instance ParentTypes Task = '[GObject.Object, AsyncResult] instance GObject Task where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_task_get_type class GObject o => TaskK o instance (GObject o, IsDescendantOf Task o) => TaskK o toTask :: TaskK o => o -> IO Task toTask = unsafeCastTo Task -- method Task::new -- method type : Constructor -- Args : [Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Task" -- throws : False -- Skip return : False foreign import ccall "g_task_new" g_task_new :: Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- callback_data : TBasicType TVoid IO (Ptr Task) taskNew :: (MonadIO m, GObject.ObjectK a, CancellableK b) => Maybe (a) -> -- source_object Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m Task taskNew source_object cancellable callback = liftIO $ do maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let callback_data = nullPtr result <- g_task_new maybeSource_object maybeCancellable maybeCallback callback_data checkUnexpectedReturnNULL "g_task_new" result result' <- (wrapObject Task) result whenJust source_object touchManagedPtr whenJust cancellable touchManagedPtr return result' -- method Task::get_cancellable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Cancellable" -- throws : False -- Skip return : False foreign import ccall "g_task_get_cancellable" g_task_get_cancellable :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO (Ptr Cancellable) taskGetCancellable :: (MonadIO m, TaskK a) => a -> -- _obj m Cancellable taskGetCancellable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_get_cancellable _obj' checkUnexpectedReturnNULL "g_task_get_cancellable" result result' <- (newObject Cancellable) result touchManagedPtr _obj return result' -- method Task::get_check_cancellable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_task_get_check_cancellable" g_task_get_check_cancellable :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO CInt taskGetCheckCancellable :: (MonadIO m, TaskK a) => a -> -- _obj m Bool taskGetCheckCancellable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_get_check_cancellable _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Task::get_completed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_task_get_completed" g_task_get_completed :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO CInt taskGetCompleted :: (MonadIO m, TaskK a) => a -> -- _obj m Bool taskGetCompleted _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_get_completed _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Task::get_context -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", 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_task_get_context" g_task_get_context :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO (Ptr GLib.MainContext) taskGetContext :: (MonadIO m, TaskK a) => a -> -- _obj m GLib.MainContext taskGetContext _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_get_context _obj' checkUnexpectedReturnNULL "g_task_get_context" result result' <- (newBoxed GLib.MainContext) result touchManagedPtr _obj return result' -- method Task::get_priority -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_task_get_priority" g_task_get_priority :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO Int32 taskGetPriority :: (MonadIO m, TaskK a) => a -> -- _obj m Int32 taskGetPriority _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_get_priority _obj' touchManagedPtr _obj return result -- method Task::get_return_on_cancel -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_task_get_return_on_cancel" g_task_get_return_on_cancel :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO CInt taskGetReturnOnCancel :: (MonadIO m, TaskK a) => a -> -- _obj m Bool taskGetReturnOnCancel _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_get_return_on_cancel _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Task::get_source_object -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_task_get_source_object" g_task_get_source_object :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO (Ptr GObject.Object) taskGetSourceObject :: (MonadIO m, TaskK a) => a -> -- _obj m GObject.Object taskGetSourceObject _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_get_source_object _obj' checkUnexpectedReturnNULL "g_task_get_source_object" result result' <- (newObject GObject.Object) result touchManagedPtr _obj return result' -- method Task::get_source_tag -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_task_get_source_tag" g_task_get_source_tag :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO () taskGetSourceTag :: (MonadIO m, TaskK a) => a -> -- _obj m () taskGetSourceTag _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_task_get_source_tag _obj' touchManagedPtr _obj return () -- method Task::get_task_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_task_get_task_data" g_task_get_task_data :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO () taskGetTaskData :: (MonadIO m, TaskK a) => a -> -- _obj m () taskGetTaskData _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_task_get_task_data _obj' touchManagedPtr _obj return () -- method Task::had_error -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_task_had_error" g_task_had_error :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO CInt taskHadError :: (MonadIO m, TaskK a) => a -> -- _obj m Bool taskHadError _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_had_error _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Task::propagate_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_task_propagate_boolean" g_task_propagate_boolean :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Ptr (Ptr GError) -> -- error IO CInt taskPropagateBoolean :: (MonadIO m, TaskK a) => a -> -- _obj m () taskPropagateBoolean _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_task_propagate_boolean _obj' touchManagedPtr _obj return () ) (do return () ) -- method Task::propagate_int -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_task_propagate_int" g_task_propagate_int :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Ptr (Ptr GError) -> -- error IO Int64 taskPropagateInt :: (MonadIO m, TaskK a) => a -> -- _obj m Int64 taskPropagateInt _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_task_propagate_int _obj' touchManagedPtr _obj return result ) (do return () ) -- method Task::propagate_pointer -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : True -- Skip return : False foreign import ccall "g_task_propagate_pointer" g_task_propagate_pointer :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Ptr (Ptr GError) -> -- error IO () taskPropagatePointer :: (MonadIO m, TaskK a) => a -> -- _obj m () taskPropagatePointer _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do propagateGError $ g_task_propagate_pointer _obj' touchManagedPtr _obj return () ) (do return () ) -- method Task::return_boolean -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", 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_task_return_boolean" g_task_return_boolean :: Ptr Task -> -- _obj : TInterface "Gio" "Task" CInt -> -- result : TBasicType TBoolean IO () taskReturnBoolean :: (MonadIO m, TaskK a) => a -> -- _obj Bool -> -- result m () taskReturnBoolean _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = (fromIntegral . fromEnum) result_ g_task_return_boolean _obj' result_' touchManagedPtr _obj return () -- method Task::return_error -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", 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 = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", 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 = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_task_return_error" g_task_return_error :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Ptr GError -> -- error : TError IO () taskReturnError :: (MonadIO m, TaskK a) => a -> -- _obj GError -> -- error m () taskReturnError _obj error_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj error_' <- copyBoxed error_ g_task_return_error _obj' error_' touchManagedPtr _obj touchManagedPtr error_ return () -- method Task::return_error_if_cancelled -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_task_return_error_if_cancelled" g_task_return_error_if_cancelled :: Ptr Task -> -- _obj : TInterface "Gio" "Task" IO CInt taskReturnErrorIfCancelled :: (MonadIO m, TaskK a) => a -> -- _obj m Bool taskReturnErrorIfCancelled _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_task_return_error_if_cancelled _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Task::return_int -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", 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_task_return_int" g_task_return_int :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Int64 -> -- result : TBasicType TInt64 IO () taskReturnInt :: (MonadIO m, TaskK a) => a -> -- _obj Int64 -> -- result m () taskReturnInt _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_task_return_int _obj' result_ touchManagedPtr _obj return () -- method Task::return_pointer -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "result_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "result_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_task_return_pointer" g_task_return_pointer :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Ptr () -> -- result : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- result_destroy : TInterface "GLib" "DestroyNotify" IO () taskReturnPointer :: (MonadIO m, TaskK a) => a -> -- _obj Maybe (Ptr ()) -> -- result Maybe (GLib.DestroyNotify) -> -- result_destroy m () taskReturnPointer _obj result_ result_destroy = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeResult_ <- case result_ of Nothing -> return nullPtr Just jResult_ -> do return jResult_ ptrresult_destroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeResult_destroy <- case result_destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jResult_destroy -> do jResult_destroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrresult_destroy) jResult_destroy) poke ptrresult_destroy jResult_destroy' return jResult_destroy' g_task_return_pointer _obj' maybeResult_ maybeResult_destroy touchManagedPtr _obj return () -- method Task::set_check_cancellable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "check_cancellable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "check_cancellable", 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_task_set_check_cancellable" g_task_set_check_cancellable :: Ptr Task -> -- _obj : TInterface "Gio" "Task" CInt -> -- check_cancellable : TBasicType TBoolean IO () taskSetCheckCancellable :: (MonadIO m, TaskK a) => a -> -- _obj Bool -> -- check_cancellable m () taskSetCheckCancellable _obj check_cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let check_cancellable' = (fromIntegral . fromEnum) check_cancellable g_task_set_check_cancellable _obj' check_cancellable' touchManagedPtr _obj return () -- method Task::set_priority -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", 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 "Gio" "Task", 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_task_set_priority" g_task_set_priority :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Int32 -> -- priority : TBasicType TInt32 IO () taskSetPriority :: (MonadIO m, TaskK a) => a -> -- _obj Int32 -> -- priority m () taskSetPriority _obj priority = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_task_set_priority _obj' priority touchManagedPtr _obj return () -- method Task::set_return_on_cancel -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_on_cancel", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_on_cancel", 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_task_set_return_on_cancel" g_task_set_return_on_cancel :: Ptr Task -> -- _obj : TInterface "Gio" "Task" CInt -> -- return_on_cancel : TBasicType TBoolean IO CInt taskSetReturnOnCancel :: (MonadIO m, TaskK a) => a -> -- _obj Bool -> -- return_on_cancel m Bool taskSetReturnOnCancel _obj return_on_cancel = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let return_on_cancel' = (fromIntegral . fromEnum) return_on_cancel result <- g_task_set_return_on_cancel _obj' return_on_cancel' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Task::set_source_tag -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_tag", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_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_task_set_source_tag" g_task_set_source_tag :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Ptr () -> -- source_tag : TBasicType TVoid IO () taskSetSourceTag :: (MonadIO m, TaskK a) => a -> -- _obj Ptr () -> -- source_tag m () taskSetSourceTag _obj source_tag = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_task_set_source_tag _obj' source_tag touchManagedPtr _obj return () -- method Task::set_task_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "task_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "task_data_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Task", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "task_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "task_data_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_task_set_task_data" g_task_set_task_data :: Ptr Task -> -- _obj : TInterface "Gio" "Task" Ptr () -> -- task_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- task_data_destroy : TInterface "GLib" "DestroyNotify" IO () taskSetTaskData :: (MonadIO m, TaskK a) => a -> -- _obj Maybe (Ptr ()) -> -- task_data Maybe (GLib.DestroyNotify) -> -- task_data_destroy m () taskSetTaskData _obj task_data task_data_destroy = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeTask_data <- case task_data of Nothing -> return nullPtr Just jTask_data -> do return jTask_data ptrtask_data_destroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeTask_data_destroy <- case task_data_destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jTask_data_destroy -> do jTask_data_destroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrtask_data_destroy) jTask_data_destroy) poke ptrtask_data_destroy jTask_data_destroy' return jTask_data_destroy' g_task_set_task_data _obj' maybeTask_data maybeTask_data_destroy touchManagedPtr _obj return () -- method Task::is_valid -- method type : MemberFunction -- Args : [Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_task_is_valid" g_task_is_valid :: Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" IO CInt taskIsValid :: (MonadIO m, AsyncResultK a, GObject.ObjectK b) => a -> -- result Maybe (b) -> -- source_object m Bool taskIsValid result_ source_object = liftIO $ do let result_' = unsafeManagedPtrCastPtr result_ maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' result <- g_task_is_valid result_' maybeSource_object let result' = (/= 0) result touchManagedPtr result_ whenJust source_object touchManagedPtr return result' -- method Task::report_error -- method type : MemberFunction -- Args : [Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 2, 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 = "source_tag", argType = TBasicType TVoid, 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 = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "source_object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_tag", argType = TBasicType TVoid, 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 = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_task_report_error" g_task_report_error :: Ptr GObject.Object -> -- source_object : TInterface "GObject" "Object" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- callback_data : TBasicType TVoid Ptr () -> -- source_tag : TBasicType TVoid Ptr GError -> -- error : TError IO () taskReportError :: (MonadIO m, GObject.ObjectK a) => Maybe (a) -> -- source_object Maybe (AsyncReadyCallback) -> -- callback Ptr () -> -- source_tag GError -> -- error m () taskReportError source_object callback source_tag error_ = liftIO $ do maybeSource_object <- case source_object of Nothing -> return nullPtr Just jSource_object -> do let jSource_object' = unsafeManagedPtrCastPtr jSource_object return jSource_object' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' error_' <- copyBoxed error_ let callback_data = nullPtr g_task_report_error maybeSource_object maybeCallback callback_data source_tag error_' whenJust source_object touchManagedPtr touchManagedPtr error_ return () -- callback TaskThreadFunc taskThreadFuncClosure :: TaskThreadFunc -> IO Closure taskThreadFuncClosure cb = newCClosure =<< mkTaskThreadFunc wrapped where wrapped = taskThreadFuncWrapper Nothing cb type TaskThreadFuncC = Ptr Task -> Ptr GObject.Object -> Ptr () -> Ptr Cancellable -> IO () foreign import ccall "wrapper" mkTaskThreadFunc :: TaskThreadFuncC -> IO (FunPtr TaskThreadFuncC) type TaskThreadFunc = Task -> GObject.Object -> Ptr () -> Maybe Cancellable -> IO () noTaskThreadFunc :: Maybe TaskThreadFunc noTaskThreadFunc = Nothing taskThreadFuncWrapper :: Maybe (Ptr (FunPtr (TaskThreadFuncC))) -> TaskThreadFunc -> Ptr Task -> Ptr GObject.Object -> Ptr () -> Ptr Cancellable -> IO () taskThreadFuncWrapper funptrptr _cb task source_object task_data cancellable = do task' <- (newObject Task) task source_object' <- (newObject GObject.Object) source_object maybeCancellable <- if cancellable == nullPtr then return Nothing else do cancellable' <- (newObject Cancellable) cancellable return $ Just cancellable' _cb task' source_object' task_data maybeCancellable maybeReleaseFunPtr funptrptr -- object TcpConnection newtype TcpConnection = TcpConnection (ForeignPtr TcpConnection) noTcpConnection :: Maybe TcpConnection noTcpConnection = Nothing foreign import ccall "g_tcp_connection_get_type" c_g_tcp_connection_get_type :: IO GType type instance ParentTypes TcpConnection = '[SocketConnection, IOStream, GObject.Object] instance GObject TcpConnection where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tcp_connection_get_type class GObject o => TcpConnectionK o instance (GObject o, IsDescendantOf TcpConnection o) => TcpConnectionK o toTcpConnection :: TcpConnectionK o => o -> IO TcpConnection toTcpConnection = unsafeCastTo TcpConnection -- method TcpConnection::get_graceful_disconnect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TcpConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TcpConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tcp_connection_get_graceful_disconnect" g_tcp_connection_get_graceful_disconnect :: Ptr TcpConnection -> -- _obj : TInterface "Gio" "TcpConnection" IO CInt tcpConnectionGetGracefulDisconnect :: (MonadIO m, TcpConnectionK a) => a -> -- _obj m Bool tcpConnectionGetGracefulDisconnect _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tcp_connection_get_graceful_disconnect _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method TcpConnection::set_graceful_disconnect -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TcpConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "graceful_disconnect", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TcpConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "graceful_disconnect", 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_tcp_connection_set_graceful_disconnect" g_tcp_connection_set_graceful_disconnect :: Ptr TcpConnection -> -- _obj : TInterface "Gio" "TcpConnection" CInt -> -- graceful_disconnect : TBasicType TBoolean IO () tcpConnectionSetGracefulDisconnect :: (MonadIO m, TcpConnectionK a) => a -> -- _obj Bool -> -- graceful_disconnect m () tcpConnectionSetGracefulDisconnect _obj graceful_disconnect = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let graceful_disconnect' = (fromIntegral . fromEnum) graceful_disconnect g_tcp_connection_set_graceful_disconnect _obj' graceful_disconnect' touchManagedPtr _obj return () -- object TcpWrapperConnection newtype TcpWrapperConnection = TcpWrapperConnection (ForeignPtr TcpWrapperConnection) noTcpWrapperConnection :: Maybe TcpWrapperConnection noTcpWrapperConnection = Nothing foreign import ccall "g_tcp_wrapper_connection_get_type" c_g_tcp_wrapper_connection_get_type :: IO GType type instance ParentTypes TcpWrapperConnection = '[TcpConnection, SocketConnection, IOStream, GObject.Object] instance GObject TcpWrapperConnection where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tcp_wrapper_connection_get_type class GObject o => TcpWrapperConnectionK o instance (GObject o, IsDescendantOf TcpWrapperConnection o) => TcpWrapperConnectionK o toTcpWrapperConnection :: TcpWrapperConnectionK o => o -> IO TcpWrapperConnection toTcpWrapperConnection = unsafeCastTo TcpWrapperConnection -- method TcpWrapperConnection::new -- method type : Constructor -- Args : [Arg {argName = "base_io_stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "socket", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_io_stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "socket", argType = TInterface "Gio" "Socket", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TcpWrapperConnection" -- throws : False -- Skip return : False foreign import ccall "g_tcp_wrapper_connection_new" g_tcp_wrapper_connection_new :: Ptr IOStream -> -- base_io_stream : TInterface "Gio" "IOStream" Ptr Socket -> -- socket : TInterface "Gio" "Socket" IO (Ptr TcpWrapperConnection) tcpWrapperConnectionNew :: (MonadIO m, IOStreamK a, SocketK b) => a -> -- base_io_stream b -> -- socket m TcpWrapperConnection tcpWrapperConnectionNew base_io_stream socket = liftIO $ do let base_io_stream' = unsafeManagedPtrCastPtr base_io_stream let socket' = unsafeManagedPtrCastPtr socket result <- g_tcp_wrapper_connection_new base_io_stream' socket' checkUnexpectedReturnNULL "g_tcp_wrapper_connection_new" result result' <- (wrapObject TcpWrapperConnection) result touchManagedPtr base_io_stream touchManagedPtr socket return result' -- method TcpWrapperConnection::get_base_io_stream -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TcpWrapperConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TcpWrapperConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "IOStream" -- throws : False -- Skip return : False foreign import ccall "g_tcp_wrapper_connection_get_base_io_stream" g_tcp_wrapper_connection_get_base_io_stream :: Ptr TcpWrapperConnection -> -- _obj : TInterface "Gio" "TcpWrapperConnection" IO (Ptr IOStream) tcpWrapperConnectionGetBaseIoStream :: (MonadIO m, TcpWrapperConnectionK a) => a -> -- _obj m IOStream tcpWrapperConnectionGetBaseIoStream _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tcp_wrapper_connection_get_base_io_stream _obj' checkUnexpectedReturnNULL "g_tcp_wrapper_connection_get_base_io_stream" result result' <- (newObject IOStream) result touchManagedPtr _obj return result' -- object TestDBus newtype TestDBus = TestDBus (ForeignPtr TestDBus) noTestDBus :: Maybe TestDBus noTestDBus = Nothing foreign import ccall "g_test_dbus_get_type" c_g_test_dbus_get_type :: IO GType type instance ParentTypes TestDBus = '[GObject.Object] instance GObject TestDBus where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_test_dbus_get_type class GObject o => TestDBusK o instance (GObject o, IsDescendantOf TestDBus o) => TestDBusK o toTestDBus :: TestDBusK o => o -> IO TestDBus toTestDBus = unsafeCastTo TestDBus -- method TestDBus::new -- method type : Constructor -- Args : [Arg {argName = "flags", argType = TInterface "Gio" "TestDBusFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "flags", argType = TInterface "Gio" "TestDBusFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TestDBus" -- throws : False -- Skip return : False foreign import ccall "g_test_dbus_new" g_test_dbus_new :: CUInt -> -- flags : TInterface "Gio" "TestDBusFlags" IO (Ptr TestDBus) testDBusNew :: (MonadIO m) => [TestDBusFlags] -> -- flags m TestDBus testDBusNew flags = liftIO $ do let flags' = gflagsToWord flags result <- g_test_dbus_new flags' checkUnexpectedReturnNULL "g_test_dbus_new" result result' <- (wrapObject TestDBus) result return result' -- method TestDBus::add_service_dir -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", 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_dbus_add_service_dir" g_test_dbus_add_service_dir :: Ptr TestDBus -> -- _obj : TInterface "Gio" "TestDBus" CString -> -- path : TBasicType TUTF8 IO () testDBusAddServiceDir :: (MonadIO m, TestDBusK a) => a -> -- _obj T.Text -> -- path m () testDBusAddServiceDir _obj path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj path' <- textToCString path g_test_dbus_add_service_dir _obj' path' touchManagedPtr _obj freeMem path' return () -- method TestDBus::down -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", 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_dbus_down" g_test_dbus_down :: Ptr TestDBus -> -- _obj : TInterface "Gio" "TestDBus" IO () testDBusDown :: (MonadIO m, TestDBusK a) => a -> -- _obj m () testDBusDown _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_test_dbus_down _obj' touchManagedPtr _obj return () -- method TestDBus::get_bus_address -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", 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_dbus_get_bus_address" g_test_dbus_get_bus_address :: Ptr TestDBus -> -- _obj : TInterface "Gio" "TestDBus" IO CString testDBusGetBusAddress :: (MonadIO m, TestDBusK a) => a -> -- _obj m T.Text testDBusGetBusAddress _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_test_dbus_get_bus_address _obj' checkUnexpectedReturnNULL "g_test_dbus_get_bus_address" result result' <- cstringToText result touchManagedPtr _obj return result' -- method TestDBus::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TestDBusFlags" -- throws : False -- Skip return : False foreign import ccall "g_test_dbus_get_flags" g_test_dbus_get_flags :: Ptr TestDBus -> -- _obj : TInterface "Gio" "TestDBus" IO CUInt testDBusGetFlags :: (MonadIO m, TestDBusK a) => a -> -- _obj m [TestDBusFlags] testDBusGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_test_dbus_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method TestDBus::stop -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", 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_dbus_stop" g_test_dbus_stop :: Ptr TestDBus -> -- _obj : TInterface "Gio" "TestDBus" IO () testDBusStop :: (MonadIO m, TestDBusK a) => a -> -- _obj m () testDBusStop _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_test_dbus_stop _obj' touchManagedPtr _obj return () -- method TestDBus::up -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TestDBus", 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_dbus_up" g_test_dbus_up :: Ptr TestDBus -> -- _obj : TInterface "Gio" "TestDBus" IO () testDBusUp :: (MonadIO m, TestDBusK a) => a -> -- _obj m () testDBusUp _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_test_dbus_up _obj' touchManagedPtr _obj return () -- method TestDBus::unset -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_test_dbus_unset" g_test_dbus_unset :: IO () testDBusUnset :: (MonadIO m) => m () testDBusUnset = liftIO $ do g_test_dbus_unset return () -- Flags TestDBusFlags data TestDBusFlags = TestDBusFlagsNone | AnotherTestDBusFlags Int deriving (Show, Eq) instance Enum TestDBusFlags where fromEnum TestDBusFlagsNone = 0 fromEnum (AnotherTestDBusFlags k) = k toEnum 0 = TestDBusFlagsNone toEnum k = AnotherTestDBusFlags k foreign import ccall "g_test_dbus_flags_get_type" c_g_test_dbus_flags_get_type :: IO GType instance BoxedEnum TestDBusFlags where boxedEnumType _ = c_g_test_dbus_flags_get_type instance IsGFlag TestDBusFlags -- object ThemedIcon newtype ThemedIcon = ThemedIcon (ForeignPtr ThemedIcon) noThemedIcon :: Maybe ThemedIcon noThemedIcon = Nothing foreign import ccall "g_themed_icon_get_type" c_g_themed_icon_get_type :: IO GType type instance ParentTypes ThemedIcon = '[GObject.Object, Icon] instance GObject ThemedIcon where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_themed_icon_get_type class GObject o => ThemedIconK o instance (GObject o, IsDescendantOf ThemedIcon o) => ThemedIconK o toThemedIcon :: ThemedIconK o => o -> IO ThemedIcon toThemedIcon = unsafeCastTo ThemedIcon -- method ThemedIcon::new -- method type : Constructor -- Args : [Arg {argName = "iconname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "iconname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ThemedIcon" -- throws : False -- Skip return : False foreign import ccall "g_themed_icon_new" g_themed_icon_new :: CString -> -- iconname : TBasicType TUTF8 IO (Ptr ThemedIcon) themedIconNew :: (MonadIO m) => T.Text -> -- iconname m ThemedIcon themedIconNew iconname = liftIO $ do iconname' <- textToCString iconname result <- g_themed_icon_new iconname' checkUnexpectedReturnNULL "g_themed_icon_new" result result' <- (wrapObject ThemedIcon) result freeMem iconname' return result' -- method ThemedIcon::new_from_names -- method type : Constructor -- Args : [Arg {argName = "iconnames", argType = TCArray False (-1) 1 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "iconnames", argType = TCArray False (-1) 1 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ThemedIcon" -- throws : False -- Skip return : False foreign import ccall "g_themed_icon_new_from_names" g_themed_icon_new_from_names :: Ptr CString -> -- iconnames : TCArray False (-1) 1 (TBasicType TUTF8) Int32 -> -- len : TBasicType TInt32 IO (Ptr ThemedIcon) themedIconNewFromNames :: (MonadIO m) => [T.Text] -> -- iconnames m ThemedIcon themedIconNewFromNames iconnames = liftIO $ do let len = fromIntegral $ length iconnames iconnames' <- packUTF8CArray iconnames result <- g_themed_icon_new_from_names iconnames' len checkUnexpectedReturnNULL "g_themed_icon_new_from_names" result result' <- (wrapObject ThemedIcon) result (mapCArrayWithLength len) freeMem iconnames' freeMem iconnames' return result' -- method ThemedIcon::new_with_default_fallbacks -- method type : Constructor -- Args : [Arg {argName = "iconname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "iconname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ThemedIcon" -- throws : False -- Skip return : False foreign import ccall "g_themed_icon_new_with_default_fallbacks" g_themed_icon_new_with_default_fallbacks :: CString -> -- iconname : TBasicType TUTF8 IO (Ptr ThemedIcon) themedIconNewWithDefaultFallbacks :: (MonadIO m) => T.Text -> -- iconname m ThemedIcon themedIconNewWithDefaultFallbacks iconname = liftIO $ do iconname' <- textToCString iconname result <- g_themed_icon_new_with_default_fallbacks iconname' checkUnexpectedReturnNULL "g_themed_icon_new_with_default_fallbacks" result result' <- (wrapObject ThemedIcon) result freeMem iconname' return result' -- method ThemedIcon::append_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ThemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iconname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ThemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iconname", 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_themed_icon_append_name" g_themed_icon_append_name :: Ptr ThemedIcon -> -- _obj : TInterface "Gio" "ThemedIcon" CString -> -- iconname : TBasicType TUTF8 IO () themedIconAppendName :: (MonadIO m, ThemedIconK a) => a -> -- _obj T.Text -> -- iconname m () themedIconAppendName _obj iconname = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj iconname' <- textToCString iconname g_themed_icon_append_name _obj' iconname' touchManagedPtr _obj freeMem iconname' return () -- method ThemedIcon::get_names -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ThemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ThemedIcon", 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_themed_icon_get_names" g_themed_icon_get_names :: Ptr ThemedIcon -> -- _obj : TInterface "Gio" "ThemedIcon" IO (Ptr CString) themedIconGetNames :: (MonadIO m, ThemedIconK a) => a -> -- _obj m [T.Text] themedIconGetNames _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_themed_icon_get_names _obj' checkUnexpectedReturnNULL "g_themed_icon_get_names" result result' <- unpackZeroTerminatedUTF8CArray result touchManagedPtr _obj return result' -- method ThemedIcon::prepend_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ThemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iconname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ThemedIcon", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iconname", 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_themed_icon_prepend_name" g_themed_icon_prepend_name :: Ptr ThemedIcon -> -- _obj : TInterface "Gio" "ThemedIcon" CString -> -- iconname : TBasicType TUTF8 IO () themedIconPrependName :: (MonadIO m, ThemedIconK a) => a -> -- _obj T.Text -> -- iconname m () themedIconPrependName _obj iconname = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj iconname' <- textToCString iconname g_themed_icon_prepend_name _obj' iconname' touchManagedPtr _obj freeMem iconname' return () -- object ThreadedSocketService newtype ThreadedSocketService = ThreadedSocketService (ForeignPtr ThreadedSocketService) noThreadedSocketService :: Maybe ThreadedSocketService noThreadedSocketService = Nothing foreign import ccall "g_threaded_socket_service_get_type" c_g_threaded_socket_service_get_type :: IO GType type instance ParentTypes ThreadedSocketService = '[SocketService, SocketListener, GObject.Object] instance GObject ThreadedSocketService where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_threaded_socket_service_get_type class GObject o => ThreadedSocketServiceK o instance (GObject o, IsDescendantOf ThreadedSocketService o) => ThreadedSocketServiceK o toThreadedSocketService :: ThreadedSocketServiceK o => o -> IO ThreadedSocketService toThreadedSocketService = unsafeCastTo ThreadedSocketService -- method ThreadedSocketService::new -- method type : Constructor -- 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 : TInterface "Gio" "ThreadedSocketService" -- throws : False -- Skip return : False foreign import ccall "g_threaded_socket_service_new" g_threaded_socket_service_new :: Int32 -> -- max_threads : TBasicType TInt32 IO (Ptr ThreadedSocketService) threadedSocketServiceNew :: (MonadIO m) => Int32 -> -- max_threads m ThreadedSocketService threadedSocketServiceNew max_threads = liftIO $ do result <- g_threaded_socket_service_new max_threads checkUnexpectedReturnNULL "g_threaded_socket_service_new" result result' <- (wrapObject ThreadedSocketService) result return result' -- signal ThreadedSocketService::run type ThreadedSocketServiceRunCallback = SocketConnection -> GObject.Object -> IO Bool noThreadedSocketServiceRunCallback :: Maybe ThreadedSocketServiceRunCallback noThreadedSocketServiceRunCallback = Nothing type ThreadedSocketServiceRunCallbackC = Ptr () -> -- object Ptr SocketConnection -> Ptr GObject.Object -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkThreadedSocketServiceRunCallback :: ThreadedSocketServiceRunCallbackC -> IO (FunPtr ThreadedSocketServiceRunCallbackC) threadedSocketServiceRunClosure :: ThreadedSocketServiceRunCallback -> IO Closure threadedSocketServiceRunClosure cb = newCClosure =<< mkThreadedSocketServiceRunCallback wrapped where wrapped = threadedSocketServiceRunCallbackWrapper cb threadedSocketServiceRunCallbackWrapper :: ThreadedSocketServiceRunCallback -> Ptr () -> Ptr SocketConnection -> Ptr GObject.Object -> Ptr () -> IO CInt threadedSocketServiceRunCallbackWrapper _cb _ connection source_object _ = do connection' <- (newObject SocketConnection) connection source_object' <- (newObject GObject.Object) source_object result <- _cb connection' source_object' let result' = (fromIntegral . fromEnum) result return result' onThreadedSocketServiceRun :: (GObject a, MonadIO m) => a -> ThreadedSocketServiceRunCallback -> m SignalHandlerId onThreadedSocketServiceRun obj cb = liftIO $ connectThreadedSocketServiceRun obj cb SignalConnectBefore afterThreadedSocketServiceRun :: (GObject a, MonadIO m) => a -> ThreadedSocketServiceRunCallback -> m SignalHandlerId afterThreadedSocketServiceRun obj cb = connectThreadedSocketServiceRun obj cb SignalConnectAfter connectThreadedSocketServiceRun :: (GObject a, MonadIO m) => a -> ThreadedSocketServiceRunCallback -> SignalConnectMode -> m SignalHandlerId connectThreadedSocketServiceRun obj cb after = liftIO $ do cb' <- mkThreadedSocketServiceRunCallback (threadedSocketServiceRunCallbackWrapper cb) connectSignalFunPtr obj "run" cb' after -- Enum TlsAuthenticationMode data TlsAuthenticationMode = TlsAuthenticationModeNone | TlsAuthenticationModeRequested | TlsAuthenticationModeRequired | AnotherTlsAuthenticationMode Int deriving (Show, Eq) instance Enum TlsAuthenticationMode where fromEnum TlsAuthenticationModeNone = 0 fromEnum TlsAuthenticationModeRequested = 1 fromEnum TlsAuthenticationModeRequired = 2 fromEnum (AnotherTlsAuthenticationMode k) = k toEnum 0 = TlsAuthenticationModeNone toEnum 1 = TlsAuthenticationModeRequested toEnum 2 = TlsAuthenticationModeRequired toEnum k = AnotherTlsAuthenticationMode k foreign import ccall "g_tls_authentication_mode_get_type" c_g_tls_authentication_mode_get_type :: IO GType instance BoxedEnum TlsAuthenticationMode where boxedEnumType _ = c_g_tls_authentication_mode_get_type -- interface TlsBackend newtype TlsBackend = TlsBackend (ForeignPtr TlsBackend) noTlsBackend :: Maybe TlsBackend noTlsBackend = Nothing foreign import ccall "g_tls_backend_get_type" c_g_tls_backend_get_type :: IO GType type instance ParentTypes TlsBackend = '[GObject.Object] instance GObject TlsBackend where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_backend_get_type class GObject o => TlsBackendK o instance (GObject o, IsDescendantOf TlsBackend o) => TlsBackendK o toTlsBackend :: TlsBackendK o => o -> IO TlsBackend toTlsBackend = unsafeCastTo TlsBackend -- method TlsBackend::get_certificate_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_tls_backend_get_certificate_type" g_tls_backend_get_certificate_type :: Ptr TlsBackend -> -- _obj : TInterface "Gio" "TlsBackend" IO CGType tlsBackendGetCertificateType :: (MonadIO m, TlsBackendK a) => a -> -- _obj m GType tlsBackendGetCertificateType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_backend_get_certificate_type _obj' let result' = GType result touchManagedPtr _obj return result' -- method TlsBackend::get_client_connection_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_tls_backend_get_client_connection_type" g_tls_backend_get_client_connection_type :: Ptr TlsBackend -> -- _obj : TInterface "Gio" "TlsBackend" IO CGType tlsBackendGetClientConnectionType :: (MonadIO m, TlsBackendK a) => a -> -- _obj m GType tlsBackendGetClientConnectionType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_backend_get_client_connection_type _obj' let result' = GType result touchManagedPtr _obj return result' -- method TlsBackend::get_default_database -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsDatabase" -- throws : False -- Skip return : False foreign import ccall "g_tls_backend_get_default_database" g_tls_backend_get_default_database :: Ptr TlsBackend -> -- _obj : TInterface "Gio" "TlsBackend" IO (Ptr TlsDatabase) tlsBackendGetDefaultDatabase :: (MonadIO m, TlsBackendK a) => a -> -- _obj m TlsDatabase tlsBackendGetDefaultDatabase _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_backend_get_default_database _obj' checkUnexpectedReturnNULL "g_tls_backend_get_default_database" result result' <- (wrapObject TlsDatabase) result touchManagedPtr _obj return result' -- method TlsBackend::get_file_database_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_tls_backend_get_file_database_type" g_tls_backend_get_file_database_type :: Ptr TlsBackend -> -- _obj : TInterface "Gio" "TlsBackend" IO CGType tlsBackendGetFileDatabaseType :: (MonadIO m, TlsBackendK a) => a -> -- _obj m GType tlsBackendGetFileDatabaseType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_backend_get_file_database_type _obj' let result' = GType result touchManagedPtr _obj return result' -- method TlsBackend::get_server_connection_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_tls_backend_get_server_connection_type" g_tls_backend_get_server_connection_type :: Ptr TlsBackend -> -- _obj : TInterface "Gio" "TlsBackend" IO CGType tlsBackendGetServerConnectionType :: (MonadIO m, TlsBackendK a) => a -> -- _obj m GType tlsBackendGetServerConnectionType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_backend_get_server_connection_type _obj' let result' = GType result touchManagedPtr _obj return result' -- method TlsBackend::supports_tls -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsBackend", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tls_backend_supports_tls" g_tls_backend_supports_tls :: Ptr TlsBackend -> -- _obj : TInterface "Gio" "TlsBackend" IO CInt tlsBackendSupportsTls :: (MonadIO m, TlsBackendK a) => a -> -- _obj m Bool tlsBackendSupportsTls _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_backend_supports_tls _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- object TlsCertificate newtype TlsCertificate = TlsCertificate (ForeignPtr TlsCertificate) noTlsCertificate :: Maybe TlsCertificate noTlsCertificate = Nothing foreign import ccall "g_tls_certificate_get_type" c_g_tls_certificate_get_type :: IO GType type instance ParentTypes TlsCertificate = '[GObject.Object] instance GObject TlsCertificate where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_certificate_get_type class GObject o => TlsCertificateK o instance (GObject o, IsDescendantOf TlsCertificate o) => TlsCertificateK o toTlsCertificate :: TlsCertificateK o => o -> IO TlsCertificate toTlsCertificate = unsafeCastTo TlsCertificate -- method TlsCertificate::new_from_file -- method type : Constructor -- Args : [Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : True -- Skip return : False foreign import ccall "g_tls_certificate_new_from_file" g_tls_certificate_new_from_file :: CString -> -- file : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr TlsCertificate) tlsCertificateNewFromFile :: (MonadIO m) => T.Text -> -- file m TlsCertificate tlsCertificateNewFromFile file = liftIO $ do file' <- textToCString file onException (do result <- propagateGError $ g_tls_certificate_new_from_file file' checkUnexpectedReturnNULL "g_tls_certificate_new_from_file" result result' <- (wrapObject TlsCertificate) result freeMem file' return result' ) (do freeMem file' ) -- method TlsCertificate::new_from_files -- method type : Constructor -- Args : [Arg {argName = "cert_file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "cert_file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key_file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : True -- Skip return : False foreign import ccall "g_tls_certificate_new_from_files" g_tls_certificate_new_from_files :: CString -> -- cert_file : TBasicType TUTF8 CString -> -- key_file : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr TlsCertificate) tlsCertificateNewFromFiles :: (MonadIO m) => T.Text -> -- cert_file T.Text -> -- key_file m TlsCertificate tlsCertificateNewFromFiles cert_file key_file = liftIO $ do cert_file' <- textToCString cert_file key_file' <- textToCString key_file onException (do result <- propagateGError $ g_tls_certificate_new_from_files cert_file' key_file' checkUnexpectedReturnNULL "g_tls_certificate_new_from_files" result result' <- (wrapObject TlsCertificate) result freeMem cert_file' freeMem key_file' return result' ) (do freeMem cert_file' freeMem key_file' ) -- method TlsCertificate::new_from_pem -- method type : Constructor -- Args : [Arg {argName = "data", 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 = "data", 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 : TInterface "Gio" "TlsCertificate" -- throws : True -- Skip return : False foreign import ccall "g_tls_certificate_new_from_pem" g_tls_certificate_new_from_pem :: CString -> -- data : TBasicType TUTF8 Int64 -> -- length : TBasicType TInt64 Ptr (Ptr GError) -> -- error IO (Ptr TlsCertificate) tlsCertificateNewFromPem :: (MonadIO m) => T.Text -> -- data Int64 -> -- length m TlsCertificate tlsCertificateNewFromPem data_ length_ = liftIO $ do data_' <- textToCString data_ onException (do result <- propagateGError $ g_tls_certificate_new_from_pem data_' length_ checkUnexpectedReturnNULL "g_tls_certificate_new_from_pem" result result' <- (wrapObject TlsCertificate) result freeMem data_' return result' ) (do freeMem data_' ) -- method TlsCertificate::get_issuer -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : False -- Skip return : False foreign import ccall "g_tls_certificate_get_issuer" g_tls_certificate_get_issuer :: Ptr TlsCertificate -> -- _obj : TInterface "Gio" "TlsCertificate" IO (Ptr TlsCertificate) tlsCertificateGetIssuer :: (MonadIO m, TlsCertificateK a) => a -> -- _obj m TlsCertificate tlsCertificateGetIssuer _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_certificate_get_issuer _obj' checkUnexpectedReturnNULL "g_tls_certificate_get_issuer" result result' <- (newObject TlsCertificate) result touchManagedPtr _obj return result' -- method TlsCertificate::is_same -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cert_two", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cert_two", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tls_certificate_is_same" g_tls_certificate_is_same :: Ptr TlsCertificate -> -- _obj : TInterface "Gio" "TlsCertificate" Ptr TlsCertificate -> -- cert_two : TInterface "Gio" "TlsCertificate" IO CInt tlsCertificateIsSame :: (MonadIO m, TlsCertificateK a, TlsCertificateK b) => a -> -- _obj b -> -- cert_two m Bool tlsCertificateIsSame _obj cert_two = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let cert_two' = unsafeManagedPtrCastPtr cert_two result <- g_tls_certificate_is_same _obj' cert_two' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr cert_two return result' -- method TlsCertificate::verify -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trusted_ca", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trusted_ca", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificateFlags" -- throws : False -- Skip return : False foreign import ccall "g_tls_certificate_verify" g_tls_certificate_verify :: Ptr TlsCertificate -> -- _obj : TInterface "Gio" "TlsCertificate" Ptr SocketConnectable -> -- identity : TInterface "Gio" "SocketConnectable" Ptr TlsCertificate -> -- trusted_ca : TInterface "Gio" "TlsCertificate" IO CUInt tlsCertificateVerify :: (MonadIO m, TlsCertificateK a, SocketConnectableK b, TlsCertificateK c) => a -> -- _obj Maybe (b) -> -- identity Maybe (c) -> -- trusted_ca m [TlsCertificateFlags] tlsCertificateVerify _obj identity trusted_ca = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeIdentity <- case identity of Nothing -> return nullPtr Just jIdentity -> do let jIdentity' = unsafeManagedPtrCastPtr jIdentity return jIdentity' maybeTrusted_ca <- case trusted_ca of Nothing -> return nullPtr Just jTrusted_ca -> do let jTrusted_ca' = unsafeManagedPtrCastPtr jTrusted_ca return jTrusted_ca' result <- g_tls_certificate_verify _obj' maybeIdentity maybeTrusted_ca let result' = wordToGFlags result touchManagedPtr _obj whenJust identity touchManagedPtr whenJust trusted_ca touchManagedPtr return result' -- method TlsCertificate::list_new_from_file -- method type : MemberFunction -- Args : [Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "file", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "TlsCertificate") -- throws : True -- Skip return : False foreign import ccall "g_tls_certificate_list_new_from_file" g_tls_certificate_list_new_from_file :: CString -> -- file : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr TlsCertificate))) tlsCertificateListNewFromFile :: (MonadIO m) => T.Text -> -- file m [TlsCertificate] tlsCertificateListNewFromFile file = liftIO $ do file' <- textToCString file onException (do result <- propagateGError $ g_tls_certificate_list_new_from_file file' checkUnexpectedReturnNULL "g_tls_certificate_list_new_from_file" result result' <- unpackGList result result'' <- mapM (wrapObject TlsCertificate) result' g_list_free result freeMem file' return result'' ) (do freeMem file' ) -- Flags TlsCertificateFlags data TlsCertificateFlags = TlsCertificateFlagsUnknownCa | TlsCertificateFlagsBadIdentity | TlsCertificateFlagsNotActivated | TlsCertificateFlagsExpired | TlsCertificateFlagsRevoked | TlsCertificateFlagsInsecure | TlsCertificateFlagsGenericError | TlsCertificateFlagsValidateAll | AnotherTlsCertificateFlags Int deriving (Show, Eq) instance Enum TlsCertificateFlags where fromEnum TlsCertificateFlagsUnknownCa = 1 fromEnum TlsCertificateFlagsBadIdentity = 2 fromEnum TlsCertificateFlagsNotActivated = 4 fromEnum TlsCertificateFlagsExpired = 8 fromEnum TlsCertificateFlagsRevoked = 16 fromEnum TlsCertificateFlagsInsecure = 32 fromEnum TlsCertificateFlagsGenericError = 64 fromEnum TlsCertificateFlagsValidateAll = 127 fromEnum (AnotherTlsCertificateFlags k) = k toEnum 1 = TlsCertificateFlagsUnknownCa toEnum 2 = TlsCertificateFlagsBadIdentity toEnum 4 = TlsCertificateFlagsNotActivated toEnum 8 = TlsCertificateFlagsExpired toEnum 16 = TlsCertificateFlagsRevoked toEnum 32 = TlsCertificateFlagsInsecure toEnum 64 = TlsCertificateFlagsGenericError toEnum 127 = TlsCertificateFlagsValidateAll toEnum k = AnotherTlsCertificateFlags k foreign import ccall "g_tls_certificate_flags_get_type" c_g_tls_certificate_flags_get_type :: IO GType instance BoxedEnum TlsCertificateFlags where boxedEnumType _ = c_g_tls_certificate_flags_get_type instance IsGFlag TlsCertificateFlags -- Enum TlsCertificateRequestFlags data TlsCertificateRequestFlags = TlsCertificateRequestFlagsNone | AnotherTlsCertificateRequestFlags Int deriving (Show, Eq) instance Enum TlsCertificateRequestFlags where fromEnum TlsCertificateRequestFlagsNone = 0 fromEnum (AnotherTlsCertificateRequestFlags k) = k toEnum 0 = TlsCertificateRequestFlagsNone toEnum k = AnotherTlsCertificateRequestFlags k foreign import ccall "g_tls_certificate_request_flags_get_type" c_g_tls_certificate_request_flags_get_type :: IO GType instance BoxedEnum TlsCertificateRequestFlags where boxedEnumType _ = c_g_tls_certificate_request_flags_get_type -- interface TlsClientConnection newtype TlsClientConnection = TlsClientConnection (ForeignPtr TlsClientConnection) noTlsClientConnection :: Maybe TlsClientConnection noTlsClientConnection = Nothing foreign import ccall "g_tls_client_connection_get_type" c_g_tls_client_connection_get_type :: IO GType type instance ParentTypes TlsClientConnection = '[TlsConnection, IOStream, GObject.Object] instance GObject TlsClientConnection where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_client_connection_get_type class GObject o => TlsClientConnectionK o instance (GObject o, IsDescendantOf TlsClientConnection o) => TlsClientConnectionK o toTlsClientConnection :: TlsClientConnectionK o => o -> IO TlsClientConnection toTlsClientConnection = unsafeCastTo TlsClientConnection -- method TlsClientConnection::get_accepted_cas -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList TByteArray -- throws : False -- Skip return : False foreign import ccall "g_tls_client_connection_get_accepted_cas" g_tls_client_connection_get_accepted_cas :: Ptr TlsClientConnection -> -- _obj : TInterface "Gio" "TlsClientConnection" IO (Ptr (GList (Ptr GByteArray))) tlsClientConnectionGetAcceptedCas :: (MonadIO m, TlsClientConnectionK a) => a -> -- _obj m [ByteString] tlsClientConnectionGetAcceptedCas _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_client_connection_get_accepted_cas _obj' checkUnexpectedReturnNULL "g_tls_client_connection_get_accepted_cas" result result' <- unpackGList result result'' <- mapM unpackGByteArray result' mapGList unrefGByteArray result g_list_free result touchManagedPtr _obj return result'' -- method TlsClientConnection::get_server_identity -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "SocketConnectable" -- throws : False -- Skip return : False foreign import ccall "g_tls_client_connection_get_server_identity" g_tls_client_connection_get_server_identity :: Ptr TlsClientConnection -> -- _obj : TInterface "Gio" "TlsClientConnection" IO (Ptr SocketConnectable) tlsClientConnectionGetServerIdentity :: (MonadIO m, TlsClientConnectionK a) => a -> -- _obj m SocketConnectable tlsClientConnectionGetServerIdentity _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_client_connection_get_server_identity _obj' checkUnexpectedReturnNULL "g_tls_client_connection_get_server_identity" result result' <- (newObject SocketConnectable) result touchManagedPtr _obj return result' -- method TlsClientConnection::get_use_ssl3 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tls_client_connection_get_use_ssl3" g_tls_client_connection_get_use_ssl3 :: Ptr TlsClientConnection -> -- _obj : TInterface "Gio" "TlsClientConnection" IO CInt tlsClientConnectionGetUseSsl3 :: (MonadIO m, TlsClientConnectionK a) => a -> -- _obj m Bool tlsClientConnectionGetUseSsl3 _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_client_connection_get_use_ssl3 _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method TlsClientConnection::get_validation_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificateFlags" -- throws : False -- Skip return : False foreign import ccall "g_tls_client_connection_get_validation_flags" g_tls_client_connection_get_validation_flags :: Ptr TlsClientConnection -> -- _obj : TInterface "Gio" "TlsClientConnection" IO CUInt tlsClientConnectionGetValidationFlags :: (MonadIO m, TlsClientConnectionK a) => a -> -- _obj m [TlsCertificateFlags] tlsClientConnectionGetValidationFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_client_connection_get_validation_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method TlsClientConnection::set_server_identity -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_client_connection_set_server_identity" g_tls_client_connection_set_server_identity :: Ptr TlsClientConnection -> -- _obj : TInterface "Gio" "TlsClientConnection" Ptr SocketConnectable -> -- identity : TInterface "Gio" "SocketConnectable" IO () tlsClientConnectionSetServerIdentity :: (MonadIO m, TlsClientConnectionK a, SocketConnectableK b) => a -> -- _obj b -> -- identity m () tlsClientConnectionSetServerIdentity _obj identity = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let identity' = unsafeManagedPtrCastPtr identity g_tls_client_connection_set_server_identity _obj' identity' touchManagedPtr _obj touchManagedPtr identity return () -- method TlsClientConnection::set_use_ssl3 -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_ssl3", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_ssl3", 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_tls_client_connection_set_use_ssl3" g_tls_client_connection_set_use_ssl3 :: Ptr TlsClientConnection -> -- _obj : TInterface "Gio" "TlsClientConnection" CInt -> -- use_ssl3 : TBasicType TBoolean IO () tlsClientConnectionSetUseSsl3 :: (MonadIO m, TlsClientConnectionK a) => a -> -- _obj Bool -> -- use_ssl3 m () tlsClientConnectionSetUseSsl3 _obj use_ssl3 = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let use_ssl3' = (fromIntegral . fromEnum) use_ssl3 g_tls_client_connection_set_use_ssl3 _obj' use_ssl3' touchManagedPtr _obj return () -- method TlsClientConnection::set_validation_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsClientConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_client_connection_set_validation_flags" g_tls_client_connection_set_validation_flags :: Ptr TlsClientConnection -> -- _obj : TInterface "Gio" "TlsClientConnection" CUInt -> -- flags : TInterface "Gio" "TlsCertificateFlags" IO () tlsClientConnectionSetValidationFlags :: (MonadIO m, TlsClientConnectionK a) => a -> -- _obj [TlsCertificateFlags] -> -- flags m () tlsClientConnectionSetValidationFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags g_tls_client_connection_set_validation_flags _obj' flags' touchManagedPtr _obj return () -- object TlsConnection newtype TlsConnection = TlsConnection (ForeignPtr TlsConnection) noTlsConnection :: Maybe TlsConnection noTlsConnection = Nothing foreign import ccall "g_tls_connection_get_type" c_g_tls_connection_get_type :: IO GType type instance ParentTypes TlsConnection = '[IOStream, GObject.Object] instance GObject TlsConnection where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_connection_get_type class GObject o => TlsConnectionK o instance (GObject o, IsDescendantOf TlsConnection o) => TlsConnectionK o toTlsConnection :: TlsConnectionK o => o -> IO TlsConnection toTlsConnection = unsafeCastTo TlsConnection -- method TlsConnection::emit_accept_certificate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "peer_cert", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "errors", argType = TInterface "Gio" "TlsCertificateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "peer_cert", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "errors", argType = TInterface "Gio" "TlsCertificateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_emit_accept_certificate" g_tls_connection_emit_accept_certificate :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" Ptr TlsCertificate -> -- peer_cert : TInterface "Gio" "TlsCertificate" CUInt -> -- errors : TInterface "Gio" "TlsCertificateFlags" IO CInt tlsConnectionEmitAcceptCertificate :: (MonadIO m, TlsConnectionK a, TlsCertificateK b) => a -> -- _obj b -> -- peer_cert [TlsCertificateFlags] -> -- errors m Bool tlsConnectionEmitAcceptCertificate _obj peer_cert errors = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let peer_cert' = unsafeManagedPtrCastPtr peer_cert let errors' = gflagsToWord errors result <- g_tls_connection_emit_accept_certificate _obj' peer_cert' errors' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr peer_cert return result' -- method TlsConnection::get_certificate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_get_certificate" g_tls_connection_get_certificate :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" IO (Ptr TlsCertificate) tlsConnectionGetCertificate :: (MonadIO m, TlsConnectionK a) => a -> -- _obj m TlsCertificate tlsConnectionGetCertificate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_connection_get_certificate _obj' checkUnexpectedReturnNULL "g_tls_connection_get_certificate" result result' <- (newObject TlsCertificate) result touchManagedPtr _obj return result' -- method TlsConnection::get_database -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsDatabase" -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_get_database" g_tls_connection_get_database :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" IO (Ptr TlsDatabase) tlsConnectionGetDatabase :: (MonadIO m, TlsConnectionK a) => a -> -- _obj m TlsDatabase tlsConnectionGetDatabase _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_connection_get_database _obj' checkUnexpectedReturnNULL "g_tls_connection_get_database" result result' <- (newObject TlsDatabase) result touchManagedPtr _obj return result' -- method TlsConnection::get_interaction -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsInteraction" -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_get_interaction" g_tls_connection_get_interaction :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" IO (Ptr TlsInteraction) tlsConnectionGetInteraction :: (MonadIO m, TlsConnectionK a) => a -> -- _obj m TlsInteraction tlsConnectionGetInteraction _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_connection_get_interaction _obj' checkUnexpectedReturnNULL "g_tls_connection_get_interaction" result result' <- (newObject TlsInteraction) result touchManagedPtr _obj return result' -- method TlsConnection::get_peer_certificate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_get_peer_certificate" g_tls_connection_get_peer_certificate :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" IO (Ptr TlsCertificate) tlsConnectionGetPeerCertificate :: (MonadIO m, TlsConnectionK a) => a -> -- _obj m TlsCertificate tlsConnectionGetPeerCertificate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_connection_get_peer_certificate _obj' checkUnexpectedReturnNULL "g_tls_connection_get_peer_certificate" result result' <- (newObject TlsCertificate) result touchManagedPtr _obj return result' -- method TlsConnection::get_peer_certificate_errors -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificateFlags" -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_get_peer_certificate_errors" g_tls_connection_get_peer_certificate_errors :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" IO CUInt tlsConnectionGetPeerCertificateErrors :: (MonadIO m, TlsConnectionK a) => a -> -- _obj m [TlsCertificateFlags] tlsConnectionGetPeerCertificateErrors _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_connection_get_peer_certificate_errors _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method TlsConnection::get_rehandshake_mode -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsRehandshakeMode" -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_get_rehandshake_mode" g_tls_connection_get_rehandshake_mode :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" IO CUInt tlsConnectionGetRehandshakeMode :: (MonadIO m, TlsConnectionK a) => a -> -- _obj m TlsRehandshakeMode tlsConnectionGetRehandshakeMode _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_connection_get_rehandshake_mode _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method TlsConnection::get_require_close_notify -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_get_require_close_notify" g_tls_connection_get_require_close_notify :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" IO CInt tlsConnectionGetRequireCloseNotify :: (MonadIO m, TlsConnectionK a) => a -> -- _obj m Bool tlsConnectionGetRequireCloseNotify _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_connection_get_require_close_notify _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method TlsConnection::get_use_system_certdb -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_get_use_system_certdb" g_tls_connection_get_use_system_certdb :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" IO CInt {-# DEPRECATED tlsConnectionGetUseSystemCertdb ["(Since version 2.30)","Use g_tls_connection_get_database() instead"]#-} tlsConnectionGetUseSystemCertdb :: (MonadIO m, TlsConnectionK a) => a -> -- _obj m Bool tlsConnectionGetUseSystemCertdb _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_connection_get_use_system_certdb _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method TlsConnection::handshake -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_tls_connection_handshake" g_tls_connection_handshake :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt tlsConnectionHandshake :: (MonadIO m, TlsConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () tlsConnectionHandshake _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_tls_connection_handshake _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method TlsConnection::handshake_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_handshake_async" g_tls_connection_handshake_async :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () tlsConnectionHandshakeAsync :: (MonadIO m, TlsConnectionK a, CancellableK b) => a -> -- _obj Int32 -> -- io_priority Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () tlsConnectionHandshakeAsync _obj io_priority cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_tls_connection_handshake_async _obj' io_priority maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method TlsConnection::handshake_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_tls_connection_handshake_finish" g_tls_connection_handshake_finish :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt tlsConnectionHandshakeFinish :: (MonadIO m, TlsConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- result m () tlsConnectionHandshakeFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_tls_connection_handshake_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method TlsConnection::set_certificate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_set_certificate" g_tls_connection_set_certificate :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" Ptr TlsCertificate -> -- certificate : TInterface "Gio" "TlsCertificate" IO () tlsConnectionSetCertificate :: (MonadIO m, TlsConnectionK a, TlsCertificateK b) => a -> -- _obj b -> -- certificate m () tlsConnectionSetCertificate _obj certificate = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let certificate' = unsafeManagedPtrCastPtr certificate g_tls_connection_set_certificate _obj' certificate' touchManagedPtr _obj touchManagedPtr certificate return () -- method TlsConnection::set_database -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "database", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "database", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_set_database" g_tls_connection_set_database :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" Ptr TlsDatabase -> -- database : TInterface "Gio" "TlsDatabase" IO () tlsConnectionSetDatabase :: (MonadIO m, TlsConnectionK a, TlsDatabaseK b) => a -> -- _obj b -> -- database m () tlsConnectionSetDatabase _obj database = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let database' = unsafeManagedPtrCastPtr database g_tls_connection_set_database _obj' database' touchManagedPtr _obj touchManagedPtr database return () -- method TlsConnection::set_interaction -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_set_interaction" g_tls_connection_set_interaction :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" IO () tlsConnectionSetInteraction :: (MonadIO m, TlsConnectionK a, TlsInteractionK b) => a -> -- _obj Maybe (b) -> -- interaction m () tlsConnectionSetInteraction _obj interaction = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' g_tls_connection_set_interaction _obj' maybeInteraction touchManagedPtr _obj whenJust interaction touchManagedPtr return () -- method TlsConnection::set_rehandshake_mode -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Gio" "TlsRehandshakeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Gio" "TlsRehandshakeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_connection_set_rehandshake_mode" g_tls_connection_set_rehandshake_mode :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" CUInt -> -- mode : TInterface "Gio" "TlsRehandshakeMode" IO () tlsConnectionSetRehandshakeMode :: (MonadIO m, TlsConnectionK a) => a -> -- _obj TlsRehandshakeMode -> -- mode m () tlsConnectionSetRehandshakeMode _obj mode = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let mode' = (fromIntegral . fromEnum) mode g_tls_connection_set_rehandshake_mode _obj' mode' touchManagedPtr _obj return () -- method TlsConnection::set_require_close_notify -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "require_close_notify", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "require_close_notify", 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_tls_connection_set_require_close_notify" g_tls_connection_set_require_close_notify :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" CInt -> -- require_close_notify : TBasicType TBoolean IO () tlsConnectionSetRequireCloseNotify :: (MonadIO m, TlsConnectionK a) => a -> -- _obj Bool -> -- require_close_notify m () tlsConnectionSetRequireCloseNotify _obj require_close_notify = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let require_close_notify' = (fromIntegral . fromEnum) require_close_notify g_tls_connection_set_require_close_notify _obj' require_close_notify' touchManagedPtr _obj return () -- method TlsConnection::set_use_system_certdb -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_system_certdb", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_system_certdb", 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_tls_connection_set_use_system_certdb" g_tls_connection_set_use_system_certdb :: Ptr TlsConnection -> -- _obj : TInterface "Gio" "TlsConnection" CInt -> -- use_system_certdb : TBasicType TBoolean IO () {-# DEPRECATED tlsConnectionSetUseSystemCertdb ["(Since version 2.30)","Use g_tls_connection_set_database() instead"]#-} tlsConnectionSetUseSystemCertdb :: (MonadIO m, TlsConnectionK a) => a -> -- _obj Bool -> -- use_system_certdb m () tlsConnectionSetUseSystemCertdb _obj use_system_certdb = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let use_system_certdb' = (fromIntegral . fromEnum) use_system_certdb g_tls_connection_set_use_system_certdb _obj' use_system_certdb' touchManagedPtr _obj return () -- signal TlsConnection::accept-certificate type TlsConnectionAcceptCertificateCallback = TlsCertificate -> [TlsCertificateFlags] -> IO Bool noTlsConnectionAcceptCertificateCallback :: Maybe TlsConnectionAcceptCertificateCallback noTlsConnectionAcceptCertificateCallback = Nothing type TlsConnectionAcceptCertificateCallbackC = Ptr () -> -- object Ptr TlsCertificate -> CUInt -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkTlsConnectionAcceptCertificateCallback :: TlsConnectionAcceptCertificateCallbackC -> IO (FunPtr TlsConnectionAcceptCertificateCallbackC) tlsConnectionAcceptCertificateClosure :: TlsConnectionAcceptCertificateCallback -> IO Closure tlsConnectionAcceptCertificateClosure cb = newCClosure =<< mkTlsConnectionAcceptCertificateCallback wrapped where wrapped = tlsConnectionAcceptCertificateCallbackWrapper cb tlsConnectionAcceptCertificateCallbackWrapper :: TlsConnectionAcceptCertificateCallback -> Ptr () -> Ptr TlsCertificate -> CUInt -> Ptr () -> IO CInt tlsConnectionAcceptCertificateCallbackWrapper _cb _ peer_cert errors _ = do peer_cert' <- (newObject TlsCertificate) peer_cert let errors' = wordToGFlags errors result <- _cb peer_cert' errors' let result' = (fromIntegral . fromEnum) result return result' onTlsConnectionAcceptCertificate :: (GObject a, MonadIO m) => a -> TlsConnectionAcceptCertificateCallback -> m SignalHandlerId onTlsConnectionAcceptCertificate obj cb = liftIO $ connectTlsConnectionAcceptCertificate obj cb SignalConnectBefore afterTlsConnectionAcceptCertificate :: (GObject a, MonadIO m) => a -> TlsConnectionAcceptCertificateCallback -> m SignalHandlerId afterTlsConnectionAcceptCertificate obj cb = connectTlsConnectionAcceptCertificate obj cb SignalConnectAfter connectTlsConnectionAcceptCertificate :: (GObject a, MonadIO m) => a -> TlsConnectionAcceptCertificateCallback -> SignalConnectMode -> m SignalHandlerId connectTlsConnectionAcceptCertificate obj cb after = liftIO $ do cb' <- mkTlsConnectionAcceptCertificateCallback (tlsConnectionAcceptCertificateCallbackWrapper cb) connectSignalFunPtr obj "accept-certificate" cb' after -- object TlsDatabase newtype TlsDatabase = TlsDatabase (ForeignPtr TlsDatabase) noTlsDatabase :: Maybe TlsDatabase noTlsDatabase = Nothing foreign import ccall "g_tls_database_get_type" c_g_tls_database_get_type :: IO GType type instance ParentTypes TlsDatabase = '[GObject.Object] instance GObject TlsDatabase where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_database_get_type class GObject o => TlsDatabaseK o instance (GObject o, IsDescendantOf TlsDatabase o) => TlsDatabaseK o toTlsDatabase :: TlsDatabaseK o => o -> IO TlsDatabase toTlsDatabase = unsafeCastTo TlsDatabase -- method TlsDatabase::create_certificate_handle -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_tls_database_create_certificate_handle" g_tls_database_create_certificate_handle :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr TlsCertificate -> -- certificate : TInterface "Gio" "TlsCertificate" IO CString tlsDatabaseCreateCertificateHandle :: (MonadIO m, TlsDatabaseK a, TlsCertificateK b) => a -> -- _obj b -> -- certificate m T.Text tlsDatabaseCreateCertificateHandle _obj certificate = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let certificate' = unsafeManagedPtrCastPtr certificate result <- g_tls_database_create_certificate_handle _obj' certificate' checkUnexpectedReturnNULL "g_tls_database_create_certificate_handle" result result' <- cstringToText result freeMem result touchManagedPtr _obj touchManagedPtr certificate return result' -- method TlsDatabase::lookup_certificate_for_handle -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : True -- Skip return : False foreign import ccall "g_tls_database_lookup_certificate_for_handle" g_tls_database_lookup_certificate_for_handle :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" CString -> -- handle : TBasicType TUTF8 Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" CUInt -> -- flags : TInterface "Gio" "TlsDatabaseLookupFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr TlsCertificate) tlsDatabaseLookupCertificateForHandle :: (MonadIO m, TlsDatabaseK a, TlsInteractionK b, CancellableK c) => a -> -- _obj T.Text -> -- handle Maybe (b) -> -- interaction TlsDatabaseLookupFlags -> -- flags Maybe (c) -> -- cancellable m TlsCertificate tlsDatabaseLookupCertificateForHandle _obj handle interaction flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj handle' <- textToCString handle maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_tls_database_lookup_certificate_for_handle _obj' handle' maybeInteraction flags' maybeCancellable checkUnexpectedReturnNULL "g_tls_database_lookup_certificate_for_handle" result result' <- (wrapObject TlsCertificate) result touchManagedPtr _obj whenJust interaction touchManagedPtr whenJust cancellable touchManagedPtr freeMem handle' return result' ) (do freeMem handle' ) -- method TlsDatabase::lookup_certificate_for_handle_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handle", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_database_lookup_certificate_for_handle_async" g_tls_database_lookup_certificate_for_handle_async :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" CString -> -- handle : TBasicType TUTF8 Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" CUInt -> -- flags : TInterface "Gio" "TlsDatabaseLookupFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () tlsDatabaseLookupCertificateForHandleAsync :: (MonadIO m, TlsDatabaseK a, TlsInteractionK b, CancellableK c) => a -> -- _obj T.Text -> -- handle Maybe (b) -> -- interaction TlsDatabaseLookupFlags -> -- flags Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () tlsDatabaseLookupCertificateForHandleAsync _obj handle interaction flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj handle' <- textToCString handle maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_tls_database_lookup_certificate_for_handle_async _obj' handle' maybeInteraction flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust interaction touchManagedPtr whenJust cancellable touchManagedPtr freeMem handle' return () -- method TlsDatabase::lookup_certificate_for_handle_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : True -- Skip return : False foreign import ccall "g_tls_database_lookup_certificate_for_handle_finish" g_tls_database_lookup_certificate_for_handle_finish :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr TlsCertificate) tlsDatabaseLookupCertificateForHandleFinish :: (MonadIO m, TlsDatabaseK a, AsyncResultK b) => a -> -- _obj b -> -- result m TlsCertificate tlsDatabaseLookupCertificateForHandleFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_tls_database_lookup_certificate_for_handle_finish _obj' result_' checkUnexpectedReturnNULL "g_tls_database_lookup_certificate_for_handle_finish" result result' <- (wrapObject TlsCertificate) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method TlsDatabase::lookup_certificate_issuer -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : True -- Skip return : False foreign import ccall "g_tls_database_lookup_certificate_issuer" g_tls_database_lookup_certificate_issuer :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr TlsCertificate -> -- certificate : TInterface "Gio" "TlsCertificate" Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" CUInt -> -- flags : TInterface "Gio" "TlsDatabaseLookupFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr TlsCertificate) tlsDatabaseLookupCertificateIssuer :: (MonadIO m, TlsDatabaseK a, TlsCertificateK b, TlsInteractionK c, CancellableK d) => a -> -- _obj b -> -- certificate Maybe (c) -> -- interaction TlsDatabaseLookupFlags -> -- flags Maybe (d) -> -- cancellable m TlsCertificate tlsDatabaseLookupCertificateIssuer _obj certificate interaction flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let certificate' = unsafeManagedPtrCastPtr certificate maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_tls_database_lookup_certificate_issuer _obj' certificate' maybeInteraction flags' maybeCancellable checkUnexpectedReturnNULL "g_tls_database_lookup_certificate_issuer" result result' <- (wrapObject TlsCertificate) result touchManagedPtr _obj touchManagedPtr certificate whenJust interaction touchManagedPtr whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method TlsDatabase::lookup_certificate_issuer_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_database_lookup_certificate_issuer_async" g_tls_database_lookup_certificate_issuer_async :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr TlsCertificate -> -- certificate : TInterface "Gio" "TlsCertificate" Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" CUInt -> -- flags : TInterface "Gio" "TlsDatabaseLookupFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () tlsDatabaseLookupCertificateIssuerAsync :: (MonadIO m, TlsDatabaseK a, TlsCertificateK b, TlsInteractionK c, CancellableK d) => a -> -- _obj b -> -- certificate Maybe (c) -> -- interaction TlsDatabaseLookupFlags -> -- flags Maybe (d) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () tlsDatabaseLookupCertificateIssuerAsync _obj certificate interaction flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let certificate' = unsafeManagedPtrCastPtr certificate maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_tls_database_lookup_certificate_issuer_async _obj' certificate' maybeInteraction flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr certificate whenJust interaction touchManagedPtr whenJust cancellable touchManagedPtr return () -- method TlsDatabase::lookup_certificate_issuer_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificate" -- throws : True -- Skip return : False foreign import ccall "g_tls_database_lookup_certificate_issuer_finish" g_tls_database_lookup_certificate_issuer_finish :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr TlsCertificate) tlsDatabaseLookupCertificateIssuerFinish :: (MonadIO m, TlsDatabaseK a, AsyncResultK b) => a -> -- _obj b -> -- result m TlsCertificate tlsDatabaseLookupCertificateIssuerFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_tls_database_lookup_certificate_issuer_finish _obj' result_' checkUnexpectedReturnNULL "g_tls_database_lookup_certificate_issuer_finish" result result' <- (wrapObject TlsCertificate) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method TlsDatabase::lookup_certificates_issued_by -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "issuer_raw_dn", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "issuer_raw_dn", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "TlsCertificate") -- throws : True -- Skip return : False foreign import ccall "g_tls_database_lookup_certificates_issued_by" g_tls_database_lookup_certificates_issued_by :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr GByteArray -> -- issuer_raw_dn : TByteArray Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" CUInt -> -- flags : TInterface "Gio" "TlsDatabaseLookupFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr TlsCertificate))) tlsDatabaseLookupCertificatesIssuedBy :: (MonadIO m, TlsDatabaseK a, TlsInteractionK b, CancellableK c) => a -> -- _obj ByteString -> -- issuer_raw_dn Maybe (b) -> -- interaction TlsDatabaseLookupFlags -> -- flags Maybe (c) -> -- cancellable m [TlsCertificate] tlsDatabaseLookupCertificatesIssuedBy _obj issuer_raw_dn interaction flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj issuer_raw_dn' <- packGByteArray issuer_raw_dn maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_tls_database_lookup_certificates_issued_by _obj' issuer_raw_dn' maybeInteraction flags' maybeCancellable checkUnexpectedReturnNULL "g_tls_database_lookup_certificates_issued_by" result result' <- unpackGList result result'' <- mapM (wrapObject TlsCertificate) result' g_list_free result touchManagedPtr _obj whenJust interaction touchManagedPtr whenJust cancellable touchManagedPtr unrefGByteArray issuer_raw_dn' return result'' ) (do unrefGByteArray issuer_raw_dn' ) -- method TlsDatabase::lookup_certificates_issued_by_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "issuer_raw_dn", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "issuer_raw_dn", argType = TByteArray, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_database_lookup_certificates_issued_by_async" g_tls_database_lookup_certificates_issued_by_async :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr GByteArray -> -- issuer_raw_dn : TByteArray Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" CUInt -> -- flags : TInterface "Gio" "TlsDatabaseLookupFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () tlsDatabaseLookupCertificatesIssuedByAsync :: (MonadIO m, TlsDatabaseK a, TlsInteractionK b, CancellableK c) => a -> -- _obj ByteString -> -- issuer_raw_dn Maybe (b) -> -- interaction TlsDatabaseLookupFlags -> -- flags Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () tlsDatabaseLookupCertificatesIssuedByAsync _obj issuer_raw_dn interaction flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj issuer_raw_dn' <- packGByteArray issuer_raw_dn maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_tls_database_lookup_certificates_issued_by_async _obj' issuer_raw_dn' maybeInteraction flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust interaction touchManagedPtr whenJust cancellable touchManagedPtr unrefGByteArray issuer_raw_dn' return () -- method TlsDatabase::lookup_certificates_issued_by_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "TlsCertificate") -- throws : True -- Skip return : False foreign import ccall "g_tls_database_lookup_certificates_issued_by_finish" g_tls_database_lookup_certificates_issued_by_finish :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr (GList (Ptr TlsCertificate))) tlsDatabaseLookupCertificatesIssuedByFinish :: (MonadIO m, TlsDatabaseK a, AsyncResultK b) => a -> -- _obj b -> -- result m [TlsCertificate] tlsDatabaseLookupCertificatesIssuedByFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_tls_database_lookup_certificates_issued_by_finish _obj' result_' checkUnexpectedReturnNULL "g_tls_database_lookup_certificates_issued_by_finish" result result' <- unpackGList result result'' <- mapM (wrapObject TlsCertificate) result' g_list_free result touchManagedPtr _obj touchManagedPtr result_ return result'' ) (do return () ) -- method TlsDatabase::verify_chain -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "chain", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "purpose", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseVerifyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "chain", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "purpose", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseVerifyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificateFlags" -- throws : True -- Skip return : False foreign import ccall "g_tls_database_verify_chain" g_tls_database_verify_chain :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr TlsCertificate -> -- chain : TInterface "Gio" "TlsCertificate" CString -> -- purpose : TBasicType TUTF8 Ptr SocketConnectable -> -- identity : TInterface "Gio" "SocketConnectable" Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" CUInt -> -- flags : TInterface "Gio" "TlsDatabaseVerifyFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CUInt tlsDatabaseVerifyChain :: (MonadIO m, TlsDatabaseK a, TlsCertificateK b, SocketConnectableK c, TlsInteractionK d, CancellableK e) => a -> -- _obj b -> -- chain T.Text -> -- purpose Maybe (c) -> -- identity Maybe (d) -> -- interaction [TlsDatabaseVerifyFlags] -> -- flags Maybe (e) -> -- cancellable m [TlsCertificateFlags] tlsDatabaseVerifyChain _obj chain purpose identity interaction flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let chain' = unsafeManagedPtrCastPtr chain purpose' <- textToCString purpose maybeIdentity <- case identity of Nothing -> return nullPtr Just jIdentity -> do let jIdentity' = unsafeManagedPtrCastPtr jIdentity return jIdentity' maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_tls_database_verify_chain _obj' chain' purpose' maybeIdentity maybeInteraction flags' maybeCancellable let result' = wordToGFlags result touchManagedPtr _obj touchManagedPtr chain whenJust identity touchManagedPtr whenJust interaction touchManagedPtr whenJust cancellable touchManagedPtr freeMem purpose' return result' ) (do freeMem purpose' ) -- method TlsDatabase::verify_chain_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "chain", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "purpose", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseVerifyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, 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 "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "chain", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "purpose", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsDatabaseVerifyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 8, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_database_verify_chain_async" g_tls_database_verify_chain_async :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr TlsCertificate -> -- chain : TInterface "Gio" "TlsCertificate" CString -> -- purpose : TBasicType TUTF8 Ptr SocketConnectable -> -- identity : TInterface "Gio" "SocketConnectable" Ptr TlsInteraction -> -- interaction : TInterface "Gio" "TlsInteraction" CUInt -> -- flags : TInterface "Gio" "TlsDatabaseVerifyFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () tlsDatabaseVerifyChainAsync :: (MonadIO m, TlsDatabaseK a, TlsCertificateK b, SocketConnectableK c, TlsInteractionK d, CancellableK e) => a -> -- _obj b -> -- chain T.Text -> -- purpose Maybe (c) -> -- identity Maybe (d) -> -- interaction [TlsDatabaseVerifyFlags] -> -- flags Maybe (e) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () tlsDatabaseVerifyChainAsync _obj chain purpose identity interaction flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let chain' = unsafeManagedPtrCastPtr chain purpose' <- textToCString purpose maybeIdentity <- case identity of Nothing -> return nullPtr Just jIdentity -> do let jIdentity' = unsafeManagedPtrCastPtr jIdentity return jIdentity' maybeInteraction <- case interaction of Nothing -> return nullPtr Just jInteraction -> do let jInteraction' = unsafeManagedPtrCastPtr jInteraction return jInteraction' let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_tls_database_verify_chain_async _obj' chain' purpose' maybeIdentity maybeInteraction flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr chain whenJust identity touchManagedPtr whenJust interaction touchManagedPtr whenJust cancellable touchManagedPtr freeMem purpose' return () -- method TlsDatabase::verify_chain_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsCertificateFlags" -- throws : True -- Skip return : False foreign import ccall "g_tls_database_verify_chain_finish" g_tls_database_verify_chain_finish :: Ptr TlsDatabase -> -- _obj : TInterface "Gio" "TlsDatabase" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CUInt tlsDatabaseVerifyChainFinish :: (MonadIO m, TlsDatabaseK a, AsyncResultK b) => a -> -- _obj b -> -- result m [TlsCertificateFlags] tlsDatabaseVerifyChainFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_tls_database_verify_chain_finish _obj' result_' let result' = wordToGFlags result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- Enum TlsDatabaseLookupFlags data TlsDatabaseLookupFlags = TlsDatabaseLookupFlagsNone | TlsDatabaseLookupFlagsKeypair | AnotherTlsDatabaseLookupFlags Int deriving (Show, Eq) instance Enum TlsDatabaseLookupFlags where fromEnum TlsDatabaseLookupFlagsNone = 0 fromEnum TlsDatabaseLookupFlagsKeypair = 1 fromEnum (AnotherTlsDatabaseLookupFlags k) = k toEnum 0 = TlsDatabaseLookupFlagsNone toEnum 1 = TlsDatabaseLookupFlagsKeypair toEnum k = AnotherTlsDatabaseLookupFlags k foreign import ccall "g_tls_database_lookup_flags_get_type" c_g_tls_database_lookup_flags_get_type :: IO GType instance BoxedEnum TlsDatabaseLookupFlags where boxedEnumType _ = c_g_tls_database_lookup_flags_get_type -- Flags TlsDatabaseVerifyFlags data TlsDatabaseVerifyFlags = TlsDatabaseVerifyFlagsNone | AnotherTlsDatabaseVerifyFlags Int deriving (Show, Eq) instance Enum TlsDatabaseVerifyFlags where fromEnum TlsDatabaseVerifyFlagsNone = 0 fromEnum (AnotherTlsDatabaseVerifyFlags k) = k toEnum 0 = TlsDatabaseVerifyFlagsNone toEnum k = AnotherTlsDatabaseVerifyFlags k foreign import ccall "g_tls_database_verify_flags_get_type" c_g_tls_database_verify_flags_get_type :: IO GType instance BoxedEnum TlsDatabaseVerifyFlags where boxedEnumType _ = c_g_tls_database_verify_flags_get_type instance IsGFlag TlsDatabaseVerifyFlags -- Enum TlsError data TlsError = TlsErrorUnavailable | TlsErrorMisc | TlsErrorBadCertificate | TlsErrorNotTls | TlsErrorHandshake | TlsErrorCertificateRequired | TlsErrorEof | AnotherTlsError Int deriving (Show, Eq) instance Enum TlsError where fromEnum TlsErrorUnavailable = 0 fromEnum TlsErrorMisc = 1 fromEnum TlsErrorBadCertificate = 2 fromEnum TlsErrorNotTls = 3 fromEnum TlsErrorHandshake = 4 fromEnum TlsErrorCertificateRequired = 5 fromEnum TlsErrorEof = 6 fromEnum (AnotherTlsError k) = k toEnum 0 = TlsErrorUnavailable toEnum 1 = TlsErrorMisc toEnum 2 = TlsErrorBadCertificate toEnum 3 = TlsErrorNotTls toEnum 4 = TlsErrorHandshake toEnum 5 = TlsErrorCertificateRequired toEnum 6 = TlsErrorEof toEnum k = AnotherTlsError k instance GErrorClass TlsError where gerrorClassDomain _ = "g-tls-error-quark" catchTlsError :: IO a -> (TlsError -> GErrorMessage -> IO a) -> IO a catchTlsError = catchGErrorJustDomain handleTlsError :: (TlsError -> GErrorMessage -> IO a) -> IO a -> IO a handleTlsError = handleGErrorJustDomain foreign import ccall "g_tls_error_get_type" c_g_tls_error_get_type :: IO GType instance BoxedEnum TlsError where boxedEnumType _ = c_g_tls_error_get_type -- interface TlsFileDatabase newtype TlsFileDatabase = TlsFileDatabase (ForeignPtr TlsFileDatabase) noTlsFileDatabase :: Maybe TlsFileDatabase noTlsFileDatabase = Nothing foreign import ccall "g_tls_file_database_get_type" c_g_tls_file_database_get_type :: IO GType type instance ParentTypes TlsFileDatabase = '[TlsDatabase, GObject.Object] instance GObject TlsFileDatabase where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_file_database_get_type class GObject o => TlsFileDatabaseK o instance (GObject o, IsDescendantOf TlsFileDatabase o) => TlsFileDatabaseK o toTlsFileDatabase :: TlsFileDatabaseK o => o -> IO TlsFileDatabase toTlsFileDatabase = unsafeCastTo TlsFileDatabase -- object TlsInteraction newtype TlsInteraction = TlsInteraction (ForeignPtr TlsInteraction) noTlsInteraction :: Maybe TlsInteraction noTlsInteraction = Nothing foreign import ccall "g_tls_interaction_get_type" c_g_tls_interaction_get_type :: IO GType type instance ParentTypes TlsInteraction = '[GObject.Object] instance GObject TlsInteraction where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_interaction_get_type class GObject o => TlsInteractionK o instance (GObject o, IsDescendantOf TlsInteraction o) => TlsInteractionK o toTlsInteraction :: TlsInteractionK o => o -> IO TlsInteraction toTlsInteraction = unsafeCastTo TlsInteraction -- method TlsInteraction::ask_password -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsInteractionResult" -- throws : True -- Skip return : False foreign import ccall "g_tls_interaction_ask_password" g_tls_interaction_ask_password :: Ptr TlsInteraction -> -- _obj : TInterface "Gio" "TlsInteraction" Ptr TlsPassword -> -- password : TInterface "Gio" "TlsPassword" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CUInt tlsInteractionAskPassword :: (MonadIO m, TlsInteractionK a, TlsPasswordK b, CancellableK c) => a -> -- _obj b -> -- password Maybe (c) -> -- cancellable m TlsInteractionResult tlsInteractionAskPassword _obj password cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let password' = unsafeManagedPtrCastPtr password maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_tls_interaction_ask_password _obj' password' maybeCancellable let result' = (toEnum . fromIntegral) result touchManagedPtr _obj touchManagedPtr password whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method TlsInteraction::ask_password_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_interaction_ask_password_async" g_tls_interaction_ask_password_async :: Ptr TlsInteraction -> -- _obj : TInterface "Gio" "TlsInteraction" Ptr TlsPassword -> -- password : TInterface "Gio" "TlsPassword" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () tlsInteractionAskPasswordAsync :: (MonadIO m, TlsInteractionK a, TlsPasswordK b, CancellableK c) => a -> -- _obj b -> -- password Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () tlsInteractionAskPasswordAsync _obj password cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let password' = unsafeManagedPtrCastPtr password maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_tls_interaction_ask_password_async _obj' password' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr password whenJust cancellable touchManagedPtr return () -- method TlsInteraction::ask_password_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsInteractionResult" -- throws : True -- Skip return : False foreign import ccall "g_tls_interaction_ask_password_finish" g_tls_interaction_ask_password_finish :: Ptr TlsInteraction -> -- _obj : TInterface "Gio" "TlsInteraction" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CUInt tlsInteractionAskPasswordFinish :: (MonadIO m, TlsInteractionK a, AsyncResultK b) => a -> -- _obj b -> -- result m TlsInteractionResult tlsInteractionAskPasswordFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_tls_interaction_ask_password_finish _obj' result_' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method TlsInteraction::invoke_ask_password -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "password", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsInteractionResult" -- throws : True -- Skip return : False foreign import ccall "g_tls_interaction_invoke_ask_password" g_tls_interaction_invoke_ask_password :: Ptr TlsInteraction -> -- _obj : TInterface "Gio" "TlsInteraction" Ptr TlsPassword -> -- password : TInterface "Gio" "TlsPassword" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CUInt tlsInteractionInvokeAskPassword :: (MonadIO m, TlsInteractionK a, TlsPasswordK b, CancellableK c) => a -> -- _obj b -> -- password Maybe (c) -> -- cancellable m TlsInteractionResult tlsInteractionInvokeAskPassword _obj password cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let password' = unsafeManagedPtrCastPtr password maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_tls_interaction_invoke_ask_password _obj' password' maybeCancellable let result' = (toEnum . fromIntegral) result touchManagedPtr _obj touchManagedPtr password whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method TlsInteraction::invoke_request_certificate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateRequestFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateRequestFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsInteractionResult" -- throws : True -- Skip return : False foreign import ccall "g_tls_interaction_invoke_request_certificate" g_tls_interaction_invoke_request_certificate :: Ptr TlsInteraction -> -- _obj : TInterface "Gio" "TlsInteraction" Ptr TlsConnection -> -- connection : TInterface "Gio" "TlsConnection" CUInt -> -- flags : TInterface "Gio" "TlsCertificateRequestFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CUInt tlsInteractionInvokeRequestCertificate :: (MonadIO m, TlsInteractionK a, TlsConnectionK b, CancellableK c) => a -> -- _obj b -> -- connection TlsCertificateRequestFlags -> -- flags Maybe (c) -> -- cancellable m TlsInteractionResult tlsInteractionInvokeRequestCertificate _obj connection flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connection' = unsafeManagedPtrCastPtr connection let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_tls_interaction_invoke_request_certificate _obj' connection' flags' maybeCancellable let result' = (toEnum . fromIntegral) result touchManagedPtr _obj touchManagedPtr connection whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method TlsInteraction::request_certificate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateRequestFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateRequestFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsInteractionResult" -- throws : True -- Skip return : False foreign import ccall "g_tls_interaction_request_certificate" g_tls_interaction_request_certificate :: Ptr TlsInteraction -> -- _obj : TInterface "Gio" "TlsInteraction" Ptr TlsConnection -> -- connection : TInterface "Gio" "TlsConnection" CUInt -> -- flags : TInterface "Gio" "TlsCertificateRequestFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CUInt tlsInteractionRequestCertificate :: (MonadIO m, TlsInteractionK a, TlsConnectionK b, CancellableK c) => a -> -- _obj b -> -- connection TlsCertificateRequestFlags -> -- flags Maybe (c) -> -- cancellable m TlsInteractionResult tlsInteractionRequestCertificate _obj connection flags cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connection' = unsafeManagedPtrCastPtr connection let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_tls_interaction_request_certificate _obj' connection' flags' maybeCancellable let result' = (toEnum . fromIntegral) result touchManagedPtr _obj touchManagedPtr connection whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method TlsInteraction::request_certificate_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateRequestFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "connection", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsCertificateRequestFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_interaction_request_certificate_async" g_tls_interaction_request_certificate_async :: Ptr TlsInteraction -> -- _obj : TInterface "Gio" "TlsInteraction" Ptr TlsConnection -> -- connection : TInterface "Gio" "TlsConnection" CUInt -> -- flags : TInterface "Gio" "TlsCertificateRequestFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () tlsInteractionRequestCertificateAsync :: (MonadIO m, TlsInteractionK a, TlsConnectionK b, CancellableK c) => a -> -- _obj b -> -- connection TlsCertificateRequestFlags -> -- flags Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () tlsInteractionRequestCertificateAsync _obj connection flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let connection' = unsafeManagedPtrCastPtr connection let flags' = (fromIntegral . fromEnum) flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_tls_interaction_request_certificate_async _obj' connection' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj touchManagedPtr connection whenJust cancellable touchManagedPtr return () -- method TlsInteraction::request_certificate_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsInteractionResult" -- throws : True -- Skip return : False foreign import ccall "g_tls_interaction_request_certificate_finish" g_tls_interaction_request_certificate_finish :: Ptr TlsInteraction -> -- _obj : TInterface "Gio" "TlsInteraction" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CUInt tlsInteractionRequestCertificateFinish :: (MonadIO m, TlsInteractionK a, AsyncResultK b) => a -> -- _obj b -> -- result m TlsInteractionResult tlsInteractionRequestCertificateFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_tls_interaction_request_certificate_finish _obj' result_' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- Enum TlsInteractionResult data TlsInteractionResult = TlsInteractionResultUnhandled | TlsInteractionResultHandled | TlsInteractionResultFailed | AnotherTlsInteractionResult Int deriving (Show, Eq) instance Enum TlsInteractionResult where fromEnum TlsInteractionResultUnhandled = 0 fromEnum TlsInteractionResultHandled = 1 fromEnum TlsInteractionResultFailed = 2 fromEnum (AnotherTlsInteractionResult k) = k toEnum 0 = TlsInteractionResultUnhandled toEnum 1 = TlsInteractionResultHandled toEnum 2 = TlsInteractionResultFailed toEnum k = AnotherTlsInteractionResult k foreign import ccall "g_tls_interaction_result_get_type" c_g_tls_interaction_result_get_type :: IO GType instance BoxedEnum TlsInteractionResult where boxedEnumType _ = c_g_tls_interaction_result_get_type -- object TlsPassword newtype TlsPassword = TlsPassword (ForeignPtr TlsPassword) noTlsPassword :: Maybe TlsPassword noTlsPassword = Nothing foreign import ccall "g_tls_password_get_type" c_g_tls_password_get_type :: IO GType type instance ParentTypes TlsPassword = '[GObject.Object] instance GObject TlsPassword where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_password_get_type class GObject o => TlsPasswordK o instance (GObject o, IsDescendantOf TlsPassword o) => TlsPasswordK o toTlsPassword :: TlsPasswordK o => o -> IO TlsPassword toTlsPassword = unsafeCastTo TlsPassword -- method TlsPassword::new -- method type : Constructor -- Args : [Arg {argName = "flags", argType = TInterface "Gio" "TlsPasswordFlags", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "flags", argType = TInterface "Gio" "TlsPasswordFlags", 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}] -- returnType : TInterface "Gio" "TlsPassword" -- throws : False -- Skip return : False foreign import ccall "g_tls_password_new" g_tls_password_new :: CUInt -> -- flags : TInterface "Gio" "TlsPasswordFlags" CString -> -- description : TBasicType TUTF8 IO (Ptr TlsPassword) tlsPasswordNew :: (MonadIO m) => [TlsPasswordFlags] -> -- flags T.Text -> -- description m TlsPassword tlsPasswordNew flags description = liftIO $ do let flags' = gflagsToWord flags description' <- textToCString description result <- g_tls_password_new flags' description' checkUnexpectedReturnNULL "g_tls_password_new" result result' <- (wrapObject TlsPassword) result freeMem description' return result' -- method TlsPassword::get_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_tls_password_get_description" g_tls_password_get_description :: Ptr TlsPassword -> -- _obj : TInterface "Gio" "TlsPassword" IO CString tlsPasswordGetDescription :: (MonadIO m, TlsPasswordK a) => a -> -- _obj m T.Text tlsPasswordGetDescription _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_password_get_description _obj' checkUnexpectedReturnNULL "g_tls_password_get_description" result result' <- cstringToText result touchManagedPtr _obj return result' -- method TlsPassword::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsPasswordFlags" -- throws : False -- Skip return : False foreign import ccall "g_tls_password_get_flags" g_tls_password_get_flags :: Ptr TlsPassword -> -- _obj : TInterface "Gio" "TlsPassword" IO CUInt tlsPasswordGetFlags :: (MonadIO m, TlsPasswordK a) => a -> -- _obj m [TlsPasswordFlags] tlsPasswordGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_password_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method TlsPassword::get_warning -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_tls_password_get_warning" g_tls_password_get_warning :: Ptr TlsPassword -> -- _obj : TInterface "Gio" "TlsPassword" IO CString tlsPasswordGetWarning :: (MonadIO m, TlsPasswordK a) => a -> -- _obj m T.Text tlsPasswordGetWarning _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_tls_password_get_warning _obj' checkUnexpectedReturnNULL "g_tls_password_get_warning" result result' <- cstringToText result touchManagedPtr _obj return result' -- method TlsPassword::set_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", 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}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_password_set_description" g_tls_password_set_description :: Ptr TlsPassword -> -- _obj : TInterface "Gio" "TlsPassword" CString -> -- description : TBasicType TUTF8 IO () tlsPasswordSetDescription :: (MonadIO m, TlsPasswordK a) => a -> -- _obj T.Text -> -- description m () tlsPasswordSetDescription _obj description = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj description' <- textToCString description g_tls_password_set_description _obj' description' touchManagedPtr _obj freeMem description' return () -- method TlsPassword::set_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsPasswordFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "TlsPasswordFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_password_set_flags" g_tls_password_set_flags :: Ptr TlsPassword -> -- _obj : TInterface "Gio" "TlsPassword" CUInt -> -- flags : TInterface "Gio" "TlsPasswordFlags" IO () tlsPasswordSetFlags :: (MonadIO m, TlsPasswordK a) => a -> -- _obj [TlsPasswordFlags] -> -- flags m () tlsPasswordSetFlags _obj flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags g_tls_password_set_flags _obj' flags' touchManagedPtr _obj return () -- method TlsPassword::set_value -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = 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 : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = 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}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_password_set_value" g_tls_password_set_value :: Ptr TlsPassword -> -- _obj : TInterface "Gio" "TlsPassword" Word8 -> -- value : TBasicType TUInt8 Int64 -> -- length : TBasicType TInt64 IO () tlsPasswordSetValue :: (MonadIO m, TlsPasswordK a) => a -> -- _obj Word8 -> -- value Int64 -> -- length m () tlsPasswordSetValue _obj value length_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_tls_password_set_value _obj' value length_ touchManagedPtr _obj return () -- method TlsPassword::set_value_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = 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},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = 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},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_tls_password_set_value_full" g_tls_password_set_value_full :: Ptr TlsPassword -> -- _obj : TInterface "Gio" "TlsPassword" Word8 -> -- value : TBasicType TUInt8 Int64 -> -- length : TBasicType TInt64 FunPtr GLib.DestroyNotifyC -> -- destroy : TInterface "GLib" "DestroyNotify" IO () tlsPasswordSetValueFull :: (MonadIO m, TlsPasswordK a) => a -> -- _obj Word8 -> -- value Int64 -> -- length Maybe (GLib.DestroyNotify) -> -- destroy m () tlsPasswordSetValueFull _obj value length_ destroy = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj ptrdestroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeDestroy <- case destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jDestroy -> do jDestroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrdestroy) jDestroy) poke ptrdestroy jDestroy' return jDestroy' g_tls_password_set_value_full _obj' value length_ maybeDestroy touchManagedPtr _obj return () -- method TlsPassword::set_warning -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warning", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsPassword", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warning", 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_tls_password_set_warning" g_tls_password_set_warning :: Ptr TlsPassword -> -- _obj : TInterface "Gio" "TlsPassword" CString -> -- warning : TBasicType TUTF8 IO () tlsPasswordSetWarning :: (MonadIO m, TlsPasswordK a) => a -> -- _obj T.Text -> -- warning m () tlsPasswordSetWarning _obj warning = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj warning' <- textToCString warning g_tls_password_set_warning _obj' warning' touchManagedPtr _obj freeMem warning' return () -- Flags TlsPasswordFlags data TlsPasswordFlags = TlsPasswordFlagsNone | TlsPasswordFlagsRetry | TlsPasswordFlagsManyTries | TlsPasswordFlagsFinalTry | AnotherTlsPasswordFlags Int deriving (Show, Eq) instance Enum TlsPasswordFlags where fromEnum TlsPasswordFlagsNone = 0 fromEnum TlsPasswordFlagsRetry = 2 fromEnum TlsPasswordFlagsManyTries = 4 fromEnum TlsPasswordFlagsFinalTry = 8 fromEnum (AnotherTlsPasswordFlags k) = k toEnum 0 = TlsPasswordFlagsNone toEnum 2 = TlsPasswordFlagsRetry toEnum 4 = TlsPasswordFlagsManyTries toEnum 8 = TlsPasswordFlagsFinalTry toEnum k = AnotherTlsPasswordFlags k foreign import ccall "g_tls_password_flags_get_type" c_g_tls_password_flags_get_type :: IO GType instance BoxedEnum TlsPasswordFlags where boxedEnumType _ = c_g_tls_password_flags_get_type instance IsGFlag TlsPasswordFlags -- Enum TlsRehandshakeMode data TlsRehandshakeMode = TlsRehandshakeModeNever | TlsRehandshakeModeSafely | TlsRehandshakeModeUnsafely | AnotherTlsRehandshakeMode Int deriving (Show, Eq) instance Enum TlsRehandshakeMode where fromEnum TlsRehandshakeModeNever = 0 fromEnum TlsRehandshakeModeSafely = 1 fromEnum TlsRehandshakeModeUnsafely = 2 fromEnum (AnotherTlsRehandshakeMode k) = k toEnum 0 = TlsRehandshakeModeNever toEnum 1 = TlsRehandshakeModeSafely toEnum 2 = TlsRehandshakeModeUnsafely toEnum k = AnotherTlsRehandshakeMode k foreign import ccall "g_tls_rehandshake_mode_get_type" c_g_tls_rehandshake_mode_get_type :: IO GType instance BoxedEnum TlsRehandshakeMode where boxedEnumType _ = c_g_tls_rehandshake_mode_get_type -- interface TlsServerConnection newtype TlsServerConnection = TlsServerConnection (ForeignPtr TlsServerConnection) noTlsServerConnection :: Maybe TlsServerConnection noTlsServerConnection = Nothing foreign import ccall "g_tls_server_connection_get_type" c_g_tls_server_connection_get_type :: IO GType type instance ParentTypes TlsServerConnection = '[TlsConnection, IOStream, GObject.Object] instance GObject TlsServerConnection where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_tls_server_connection_get_type class GObject o => TlsServerConnectionK o instance (GObject o, IsDescendantOf TlsServerConnection o) => TlsServerConnectionK o toTlsServerConnection :: TlsServerConnectionK o => o -> IO TlsServerConnection toTlsServerConnection = unsafeCastTo TlsServerConnection -- object UnixConnection newtype UnixConnection = UnixConnection (ForeignPtr UnixConnection) noUnixConnection :: Maybe UnixConnection noUnixConnection = Nothing foreign import ccall "g_unix_connection_get_type" c_g_unix_connection_get_type :: IO GType type instance ParentTypes UnixConnection = '[SocketConnection, IOStream, GObject.Object] instance GObject UnixConnection where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_unix_connection_get_type class GObject o => UnixConnectionK o instance (GObject o, IsDescendantOf UnixConnection o) => UnixConnectionK o toUnixConnection :: UnixConnectionK o => o -> IO UnixConnection toUnixConnection = unsafeCastTo UnixConnection -- method UnixConnection::receive_credentials -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Credentials" -- throws : True -- Skip return : False foreign import ccall "g_unix_connection_receive_credentials" g_unix_connection_receive_credentials :: Ptr UnixConnection -> -- _obj : TInterface "Gio" "UnixConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr Credentials) unixConnectionReceiveCredentials :: (MonadIO m, UnixConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Credentials unixConnectionReceiveCredentials _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_unix_connection_receive_credentials _obj' maybeCancellable checkUnexpectedReturnNULL "g_unix_connection_receive_credentials" result result' <- (wrapObject Credentials) result touchManagedPtr _obj whenJust cancellable touchManagedPtr return result' ) (do return () ) -- method UnixConnection::receive_credentials_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_unix_connection_receive_credentials_async" g_unix_connection_receive_credentials_async :: Ptr UnixConnection -> -- _obj : TInterface "Gio" "UnixConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () unixConnectionReceiveCredentialsAsync :: (MonadIO m, UnixConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () unixConnectionReceiveCredentialsAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_unix_connection_receive_credentials_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method UnixConnection::receive_credentials_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Credentials" -- throws : True -- Skip return : False foreign import ccall "g_unix_connection_receive_credentials_finish" g_unix_connection_receive_credentials_finish :: Ptr UnixConnection -> -- _obj : TInterface "Gio" "UnixConnection" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr Credentials) unixConnectionReceiveCredentialsFinish :: (MonadIO m, UnixConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- result m Credentials unixConnectionReceiveCredentialsFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do result <- propagateGError $ g_unix_connection_receive_credentials_finish _obj' result_' checkUnexpectedReturnNULL "g_unix_connection_receive_credentials_finish" result result' <- (wrapObject Credentials) result touchManagedPtr _obj touchManagedPtr result_ return result' ) (do return () ) -- method UnixConnection::receive_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_unix_connection_receive_fd" g_unix_connection_receive_fd :: Ptr UnixConnection -> -- _obj : TInterface "Gio" "UnixConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int32 unixConnectionReceiveFd :: (MonadIO m, UnixConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m Int32 unixConnectionReceiveFd _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_unix_connection_receive_fd _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return result ) (do return () ) -- method UnixConnection::send_credentials -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_unix_connection_send_credentials" g_unix_connection_send_credentials :: Ptr UnixConnection -> -- _obj : TInterface "Gio" "UnixConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt unixConnectionSendCredentials :: (MonadIO m, UnixConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable m () unixConnectionSendCredentials _obj cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_unix_connection_send_credentials _obj' maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- method UnixConnection::send_credentials_async -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_unix_connection_send_credentials_async" g_unix_connection_send_credentials_async :: Ptr UnixConnection -> -- _obj : TInterface "Gio" "UnixConnection" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () unixConnectionSendCredentialsAsync :: (MonadIO m, UnixConnectionK a, CancellableK b) => a -> -- _obj Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () unixConnectionSendCredentialsAsync _obj cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_unix_connection_send_credentials_async _obj' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method UnixConnection::send_credentials_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", 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_connection_send_credentials_finish" g_unix_connection_send_credentials_finish :: Ptr UnixConnection -> -- _obj : TInterface "Gio" "UnixConnection" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt unixConnectionSendCredentialsFinish :: (MonadIO m, UnixConnectionK a, AsyncResultK b) => a -> -- _obj b -> -- result m () unixConnectionSendCredentialsFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_unix_connection_send_credentials_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method UnixConnection::send_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixConnection", 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 = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_unix_connection_send_fd" g_unix_connection_send_fd :: Ptr UnixConnection -> -- _obj : TInterface "Gio" "UnixConnection" Int32 -> -- fd : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt unixConnectionSendFd :: (MonadIO m, UnixConnectionK a, CancellableK b) => a -> -- _obj Int32 -> -- fd Maybe (b) -> -- cancellable m () unixConnectionSendFd _obj fd cancellable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_unix_connection_send_fd _obj' fd maybeCancellable touchManagedPtr _obj whenJust cancellable touchManagedPtr return () ) (do return () ) -- object UnixCredentialsMessage newtype UnixCredentialsMessage = UnixCredentialsMessage (ForeignPtr UnixCredentialsMessage) noUnixCredentialsMessage :: Maybe UnixCredentialsMessage noUnixCredentialsMessage = Nothing foreign import ccall "g_unix_credentials_message_get_type" c_g_unix_credentials_message_get_type :: IO GType type instance ParentTypes UnixCredentialsMessage = '[SocketControlMessage, GObject.Object] instance GObject UnixCredentialsMessage where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_unix_credentials_message_get_type class GObject o => UnixCredentialsMessageK o instance (GObject o, IsDescendantOf UnixCredentialsMessage o) => UnixCredentialsMessageK o toUnixCredentialsMessage :: UnixCredentialsMessageK o => o -> IO UnixCredentialsMessage toUnixCredentialsMessage = unsafeCastTo UnixCredentialsMessage -- method UnixCredentialsMessage::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "UnixCredentialsMessage" -- throws : False -- Skip return : False foreign import ccall "g_unix_credentials_message_new" g_unix_credentials_message_new :: IO (Ptr UnixCredentialsMessage) unixCredentialsMessageNew :: (MonadIO m) => m UnixCredentialsMessage unixCredentialsMessageNew = liftIO $ do result <- g_unix_credentials_message_new checkUnexpectedReturnNULL "g_unix_credentials_message_new" result result' <- (wrapObject UnixCredentialsMessage) result return result' -- method UnixCredentialsMessage::new_with_credentials -- method type : Constructor -- Args : [Arg {argName = "credentials", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "credentials", argType = TInterface "Gio" "Credentials", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixCredentialsMessage" -- throws : False -- Skip return : False foreign import ccall "g_unix_credentials_message_new_with_credentials" g_unix_credentials_message_new_with_credentials :: Ptr Credentials -> -- credentials : TInterface "Gio" "Credentials" IO (Ptr UnixCredentialsMessage) unixCredentialsMessageNewWithCredentials :: (MonadIO m, CredentialsK a) => a -> -- credentials m UnixCredentialsMessage unixCredentialsMessageNewWithCredentials credentials = liftIO $ do let credentials' = unsafeManagedPtrCastPtr credentials result <- g_unix_credentials_message_new_with_credentials credentials' checkUnexpectedReturnNULL "g_unix_credentials_message_new_with_credentials" result result' <- (wrapObject UnixCredentialsMessage) result touchManagedPtr credentials return result' -- method UnixCredentialsMessage::get_credentials -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixCredentialsMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixCredentialsMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Credentials" -- throws : False -- Skip return : False foreign import ccall "g_unix_credentials_message_get_credentials" g_unix_credentials_message_get_credentials :: Ptr UnixCredentialsMessage -> -- _obj : TInterface "Gio" "UnixCredentialsMessage" IO (Ptr Credentials) unixCredentialsMessageGetCredentials :: (MonadIO m, UnixCredentialsMessageK a) => a -> -- _obj m Credentials unixCredentialsMessageGetCredentials _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_credentials_message_get_credentials _obj' checkUnexpectedReturnNULL "g_unix_credentials_message_get_credentials" result result' <- (newObject Credentials) result touchManagedPtr _obj return result' -- method UnixCredentialsMessage::is_supported -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_credentials_message_is_supported" g_unix_credentials_message_is_supported :: IO CInt unixCredentialsMessageIsSupported :: (MonadIO m) => m Bool unixCredentialsMessageIsSupported = liftIO $ do result <- g_unix_credentials_message_is_supported let result' = (/= 0) result return result' -- object UnixFDList newtype UnixFDList = UnixFDList (ForeignPtr UnixFDList) noUnixFDList :: Maybe UnixFDList noUnixFDList = Nothing foreign import ccall "g_unix_fd_list_get_type" c_g_unix_fd_list_get_type :: IO GType type instance ParentTypes UnixFDList = '[GObject.Object] instance GObject UnixFDList where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_unix_fd_list_get_type class GObject o => UnixFDListK o instance (GObject o, IsDescendantOf UnixFDList o) => UnixFDListK o toUnixFDList :: UnixFDListK o => o -> IO UnixFDList toUnixFDList = unsafeCastTo UnixFDList -- method UnixFDList::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "UnixFDList" -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_list_new" g_unix_fd_list_new :: IO (Ptr UnixFDList) unixFDListNew :: (MonadIO m) => m UnixFDList unixFDListNew = liftIO $ do result <- g_unix_fd_list_new checkUnexpectedReturnNULL "g_unix_fd_list_new" result result' <- (wrapObject UnixFDList) result return result' -- method UnixFDList::new_from_array -- method type : Constructor -- Args : [Arg {argName = "fds", argType = TCArray False (-1) 1 (TBasicType TInt32), 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 = "fds", argType = TCArray False (-1) 1 (TBasicType TInt32), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixFDList" -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_list_new_from_array" g_unix_fd_list_new_from_array :: Ptr Int32 -> -- fds : TCArray False (-1) 1 (TBasicType TInt32) Int32 -> -- n_fds : TBasicType TInt32 IO (Ptr UnixFDList) unixFDListNewFromArray :: (MonadIO m) => [Int32] -> -- fds m UnixFDList unixFDListNewFromArray fds = liftIO $ do let n_fds = fromIntegral $ length fds fds' <- packStorableArray fds result <- g_unix_fd_list_new_from_array fds' n_fds checkUnexpectedReturnNULL "g_unix_fd_list_new_from_array" result result' <- (wrapObject UnixFDList) result freeMem fds' return result' -- method UnixFDList::append -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", 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}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_unix_fd_list_append" g_unix_fd_list_append :: Ptr UnixFDList -> -- _obj : TInterface "Gio" "UnixFDList" Int32 -> -- fd : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO Int32 unixFDListAppend :: (MonadIO m, UnixFDListK a) => a -> -- _obj Int32 -> -- fd m Int32 unixFDListAppend _obj fd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_unix_fd_list_append _obj' fd touchManagedPtr _obj return result ) (do return () ) -- method UnixFDList::get -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : True -- Skip return : False foreign import ccall "g_unix_fd_list_get" g_unix_fd_list_get :: Ptr UnixFDList -> -- _obj : TInterface "Gio" "UnixFDList" Int32 -> -- index_ : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO Int32 unixFDListGet :: (MonadIO m, UnixFDListK a) => a -> -- _obj Int32 -> -- index_ m Int32 unixFDListGet _obj index_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do result <- propagateGError $ g_unix_fd_list_get _obj' index_ touchManagedPtr _obj return result ) (do return () ) -- method UnixFDList::get_length -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_list_get_length" g_unix_fd_list_get_length :: Ptr UnixFDList -> -- _obj : TInterface "Gio" "UnixFDList" IO Int32 unixFDListGetLength :: (MonadIO m, UnixFDListK a) => a -> -- _obj m Int32 unixFDListGetLength _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_fd_list_get_length _obj' touchManagedPtr _obj return result -- method UnixFDList::peek_fds -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TInt32) -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_list_peek_fds" g_unix_fd_list_peek_fds :: Ptr UnixFDList -> -- _obj : TInterface "Gio" "UnixFDList" Ptr Int32 -> -- length : TBasicType TInt32 IO (Ptr Int32) unixFDListPeekFds :: (MonadIO m, UnixFDListK a) => a -> -- _obj m [Int32] unixFDListPeekFds _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj length_ <- allocMem :: IO (Ptr Int32) result <- g_unix_fd_list_peek_fds _obj' length_ length_' <- peek length_ checkUnexpectedReturnNULL "g_unix_fd_list_peek_fds" result result' <- (unpackStorableArrayWithLength length_') result touchManagedPtr _obj freeMem length_ return result' -- method UnixFDList::steal_fds -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TInt32) -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_list_steal_fds" g_unix_fd_list_steal_fds :: Ptr UnixFDList -> -- _obj : TInterface "Gio" "UnixFDList" Ptr Int32 -> -- length : TBasicType TInt32 IO (Ptr Int32) unixFDListStealFds :: (MonadIO m, UnixFDListK a) => a -> -- _obj m [Int32] unixFDListStealFds _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj length_ <- allocMem :: IO (Ptr Int32) result <- g_unix_fd_list_steal_fds _obj' length_ length_' <- peek length_ checkUnexpectedReturnNULL "g_unix_fd_list_steal_fds" result result' <- (unpackStorableArrayWithLength length_') result freeMem result touchManagedPtr _obj freeMem length_ return result' -- object UnixFDMessage newtype UnixFDMessage = UnixFDMessage (ForeignPtr UnixFDMessage) noUnixFDMessage :: Maybe UnixFDMessage noUnixFDMessage = Nothing foreign import ccall "g_unix_fd_message_get_type" c_g_unix_fd_message_get_type :: IO GType type instance ParentTypes UnixFDMessage = '[SocketControlMessage, GObject.Object] instance GObject UnixFDMessage where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_unix_fd_message_get_type class GObject o => UnixFDMessageK o instance (GObject o, IsDescendantOf UnixFDMessage o) => UnixFDMessageK o toUnixFDMessage :: UnixFDMessageK o => o -> IO UnixFDMessage toUnixFDMessage = unsafeCastTo UnixFDMessage -- method UnixFDMessage::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "UnixFDMessage" -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_message_new" g_unix_fd_message_new :: IO (Ptr UnixFDMessage) unixFDMessageNew :: (MonadIO m) => m UnixFDMessage unixFDMessageNew = liftIO $ do result <- g_unix_fd_message_new checkUnexpectedReturnNULL "g_unix_fd_message_new" result result' <- (wrapObject UnixFDMessage) result return result' -- method UnixFDMessage::new_with_fd_list -- method type : Constructor -- Args : [Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "fd_list", argType = TInterface "Gio" "UnixFDList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixFDMessage" -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_message_new_with_fd_list" g_unix_fd_message_new_with_fd_list :: Ptr UnixFDList -> -- fd_list : TInterface "Gio" "UnixFDList" IO (Ptr UnixFDMessage) unixFDMessageNewWithFdList :: (MonadIO m, UnixFDListK a) => a -> -- fd_list m UnixFDMessage unixFDMessageNewWithFdList fd_list = liftIO $ do let fd_list' = unsafeManagedPtrCastPtr fd_list result <- g_unix_fd_message_new_with_fd_list fd_list' checkUnexpectedReturnNULL "g_unix_fd_message_new_with_fd_list" result result' <- (wrapObject UnixFDMessage) result touchManagedPtr fd_list return result' -- method UnixFDMessage::append_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDMessage", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDMessage", 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}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_unix_fd_message_append_fd" g_unix_fd_message_append_fd :: Ptr UnixFDMessage -> -- _obj : TInterface "Gio" "UnixFDMessage" Int32 -> -- fd : TBasicType TInt32 Ptr (Ptr GError) -> -- error IO CInt unixFDMessageAppendFd :: (MonadIO m, UnixFDMessageK a) => a -> -- _obj Int32 -> -- fd m () unixFDMessageAppendFd _obj fd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj onException (do _ <- propagateGError $ g_unix_fd_message_append_fd _obj' fd touchManagedPtr _obj return () ) (do return () ) -- method UnixFDMessage::get_fd_list -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixFDList" -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_message_get_fd_list" g_unix_fd_message_get_fd_list :: Ptr UnixFDMessage -> -- _obj : TInterface "Gio" "UnixFDMessage" IO (Ptr UnixFDList) unixFDMessageGetFdList :: (MonadIO m, UnixFDMessageK a) => a -> -- _obj m UnixFDList unixFDMessageGetFdList _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_fd_message_get_fd_list _obj' checkUnexpectedReturnNULL "g_unix_fd_message_get_fd_list" result result' <- (newObject UnixFDList) result touchManagedPtr _obj return result' -- method UnixFDMessage::steal_fds -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixFDMessage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TInt32) -- throws : False -- Skip return : False foreign import ccall "g_unix_fd_message_steal_fds" g_unix_fd_message_steal_fds :: Ptr UnixFDMessage -> -- _obj : TInterface "Gio" "UnixFDMessage" Ptr Int32 -> -- length : TBasicType TInt32 IO (Ptr Int32) unixFDMessageStealFds :: (MonadIO m, UnixFDMessageK a) => a -> -- _obj m [Int32] unixFDMessageStealFds _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj length_ <- allocMem :: IO (Ptr Int32) result <- g_unix_fd_message_steal_fds _obj' length_ length_' <- peek length_ checkUnexpectedReturnNULL "g_unix_fd_message_steal_fds" result result' <- (unpackStorableArrayWithLength length_') result freeMem result touchManagedPtr _obj freeMem length_ return result' -- object UnixInputStream newtype UnixInputStream = UnixInputStream (ForeignPtr UnixInputStream) noUnixInputStream :: Maybe UnixInputStream noUnixInputStream = Nothing foreign import ccall "g_unix_input_stream_get_type" c_g_unix_input_stream_get_type :: IO GType type instance ParentTypes UnixInputStream = '[InputStream, GObject.Object, FileDescriptorBased, PollableInputStream] instance GObject UnixInputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_unix_input_stream_get_type class GObject o => UnixInputStreamK o instance (GObject o, IsDescendantOf UnixInputStream o) => UnixInputStreamK o toUnixInputStream :: UnixInputStreamK o => o -> IO UnixInputStream toUnixInputStream = unsafeCastTo UnixInputStream -- method UnixInputStream::new -- method type : Constructor -- Args : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_fd", 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 = "close_fd", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixInputStream" -- throws : False -- Skip return : False foreign import ccall "g_unix_input_stream_new" g_unix_input_stream_new :: Int32 -> -- fd : TBasicType TInt32 CInt -> -- close_fd : TBasicType TBoolean IO (Ptr UnixInputStream) unixInputStreamNew :: (MonadIO m) => Int32 -> -- fd Bool -> -- close_fd m UnixInputStream unixInputStreamNew fd close_fd = liftIO $ do let close_fd' = (fromIntegral . fromEnum) close_fd result <- g_unix_input_stream_new fd close_fd' checkUnexpectedReturnNULL "g_unix_input_stream_new" result result' <- (wrapObject UnixInputStream) result return result' -- method UnixInputStream::get_close_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_input_stream_get_close_fd" g_unix_input_stream_get_close_fd :: Ptr UnixInputStream -> -- _obj : TInterface "Gio" "UnixInputStream" IO CInt unixInputStreamGetCloseFd :: (MonadIO m, UnixInputStreamK a) => a -> -- _obj m Bool unixInputStreamGetCloseFd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_input_stream_get_close_fd _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method UnixInputStream::get_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unix_input_stream_get_fd" g_unix_input_stream_get_fd :: Ptr UnixInputStream -> -- _obj : TInterface "Gio" "UnixInputStream" IO Int32 unixInputStreamGetFd :: (MonadIO m, UnixInputStreamK a) => a -> -- _obj m Int32 unixInputStreamGetFd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_input_stream_get_fd _obj' touchManagedPtr _obj return result -- method UnixInputStream::set_close_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_fd", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixInputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_fd", 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_unix_input_stream_set_close_fd" g_unix_input_stream_set_close_fd :: Ptr UnixInputStream -> -- _obj : TInterface "Gio" "UnixInputStream" CInt -> -- close_fd : TBasicType TBoolean IO () unixInputStreamSetCloseFd :: (MonadIO m, UnixInputStreamK a) => a -> -- _obj Bool -> -- close_fd m () unixInputStreamSetCloseFd _obj close_fd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let close_fd' = (fromIntegral . fromEnum) close_fd g_unix_input_stream_set_close_fd _obj' close_fd' touchManagedPtr _obj return () -- struct UnixMountEntry newtype UnixMountEntry = UnixMountEntry (ForeignPtr UnixMountEntry) noUnixMountEntry :: Maybe UnixMountEntry noUnixMountEntry = Nothing -- object UnixMountMonitor newtype UnixMountMonitor = UnixMountMonitor (ForeignPtr UnixMountMonitor) noUnixMountMonitor :: Maybe UnixMountMonitor noUnixMountMonitor = Nothing foreign import ccall "g_unix_mount_monitor_get_type" c_g_unix_mount_monitor_get_type :: IO GType type instance ParentTypes UnixMountMonitor = '[GObject.Object] instance GObject UnixMountMonitor where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_unix_mount_monitor_get_type class GObject o => UnixMountMonitorK o instance (GObject o, IsDescendantOf UnixMountMonitor o) => UnixMountMonitorK o toUnixMountMonitor :: UnixMountMonitorK o => o -> IO UnixMountMonitor toUnixMountMonitor = unsafeCastTo UnixMountMonitor -- method UnixMountMonitor::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "UnixMountMonitor" -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_monitor_new" g_unix_mount_monitor_new :: IO (Ptr UnixMountMonitor) {-# DEPRECATED unixMountMonitorNew ["(Since version 2.44)","Use g_unix_mount_monitor_get() instead."]#-} unixMountMonitorNew :: (MonadIO m) => m UnixMountMonitor unixMountMonitorNew = liftIO $ do result <- g_unix_mount_monitor_new checkUnexpectedReturnNULL "g_unix_mount_monitor_new" result result' <- (wrapObject UnixMountMonitor) result return result' -- method UnixMountMonitor::set_rate_limit -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit_msec", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "limit_msec", 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_unix_mount_monitor_set_rate_limit" g_unix_mount_monitor_set_rate_limit :: Ptr UnixMountMonitor -> -- _obj : TInterface "Gio" "UnixMountMonitor" Int32 -> -- limit_msec : TBasicType TInt32 IO () {-# DEPRECATED unixMountMonitorSetRateLimit ["(Since version 2.44)","This function does nothing. Don't call it."]#-} unixMountMonitorSetRateLimit :: (MonadIO m, UnixMountMonitorK a) => a -> -- _obj Int32 -> -- limit_msec m () unixMountMonitorSetRateLimit _obj limit_msec = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_unix_mount_monitor_set_rate_limit _obj' limit_msec touchManagedPtr _obj return () -- method UnixMountMonitor::get -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "UnixMountMonitor" -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_monitor_get" g_unix_mount_monitor_get :: IO (Ptr UnixMountMonitor) unixMountMonitorGet :: (MonadIO m) => m UnixMountMonitor unixMountMonitorGet = liftIO $ do result <- g_unix_mount_monitor_get checkUnexpectedReturnNULL "g_unix_mount_monitor_get" result result' <- (wrapObject UnixMountMonitor) result return result' -- signal UnixMountMonitor::mountpoints-changed type UnixMountMonitorMountpointsChangedCallback = IO () noUnixMountMonitorMountpointsChangedCallback :: Maybe UnixMountMonitorMountpointsChangedCallback noUnixMountMonitorMountpointsChangedCallback = Nothing type UnixMountMonitorMountpointsChangedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkUnixMountMonitorMountpointsChangedCallback :: UnixMountMonitorMountpointsChangedCallbackC -> IO (FunPtr UnixMountMonitorMountpointsChangedCallbackC) unixMountMonitorMountpointsChangedClosure :: UnixMountMonitorMountpointsChangedCallback -> IO Closure unixMountMonitorMountpointsChangedClosure cb = newCClosure =<< mkUnixMountMonitorMountpointsChangedCallback wrapped where wrapped = unixMountMonitorMountpointsChangedCallbackWrapper cb unixMountMonitorMountpointsChangedCallbackWrapper :: UnixMountMonitorMountpointsChangedCallback -> Ptr () -> Ptr () -> IO () unixMountMonitorMountpointsChangedCallbackWrapper _cb _ _ = do _cb onUnixMountMonitorMountpointsChanged :: (GObject a, MonadIO m) => a -> UnixMountMonitorMountpointsChangedCallback -> m SignalHandlerId onUnixMountMonitorMountpointsChanged obj cb = liftIO $ connectUnixMountMonitorMountpointsChanged obj cb SignalConnectBefore afterUnixMountMonitorMountpointsChanged :: (GObject a, MonadIO m) => a -> UnixMountMonitorMountpointsChangedCallback -> m SignalHandlerId afterUnixMountMonitorMountpointsChanged obj cb = connectUnixMountMonitorMountpointsChanged obj cb SignalConnectAfter connectUnixMountMonitorMountpointsChanged :: (GObject a, MonadIO m) => a -> UnixMountMonitorMountpointsChangedCallback -> SignalConnectMode -> m SignalHandlerId connectUnixMountMonitorMountpointsChanged obj cb after = liftIO $ do cb' <- mkUnixMountMonitorMountpointsChangedCallback (unixMountMonitorMountpointsChangedCallbackWrapper cb) connectSignalFunPtr obj "mountpoints-changed" cb' after -- signal UnixMountMonitor::mounts-changed type UnixMountMonitorMountsChangedCallback = IO () noUnixMountMonitorMountsChangedCallback :: Maybe UnixMountMonitorMountsChangedCallback noUnixMountMonitorMountsChangedCallback = Nothing type UnixMountMonitorMountsChangedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkUnixMountMonitorMountsChangedCallback :: UnixMountMonitorMountsChangedCallbackC -> IO (FunPtr UnixMountMonitorMountsChangedCallbackC) unixMountMonitorMountsChangedClosure :: UnixMountMonitorMountsChangedCallback -> IO Closure unixMountMonitorMountsChangedClosure cb = newCClosure =<< mkUnixMountMonitorMountsChangedCallback wrapped where wrapped = unixMountMonitorMountsChangedCallbackWrapper cb unixMountMonitorMountsChangedCallbackWrapper :: UnixMountMonitorMountsChangedCallback -> Ptr () -> Ptr () -> IO () unixMountMonitorMountsChangedCallbackWrapper _cb _ _ = do _cb onUnixMountMonitorMountsChanged :: (GObject a, MonadIO m) => a -> UnixMountMonitorMountsChangedCallback -> m SignalHandlerId onUnixMountMonitorMountsChanged obj cb = liftIO $ connectUnixMountMonitorMountsChanged obj cb SignalConnectBefore afterUnixMountMonitorMountsChanged :: (GObject a, MonadIO m) => a -> UnixMountMonitorMountsChangedCallback -> m SignalHandlerId afterUnixMountMonitorMountsChanged obj cb = connectUnixMountMonitorMountsChanged obj cb SignalConnectAfter connectUnixMountMonitorMountsChanged :: (GObject a, MonadIO m) => a -> UnixMountMonitorMountsChangedCallback -> SignalConnectMode -> m SignalHandlerId connectUnixMountMonitorMountsChanged obj cb after = liftIO $ do cb' <- mkUnixMountMonitorMountsChangedCallback (unixMountMonitorMountsChangedCallbackWrapper cb) connectSignalFunPtr obj "mounts-changed" cb' after -- struct UnixMountPoint newtype UnixMountPoint = UnixMountPoint (ForeignPtr UnixMountPoint) noUnixMountPoint :: Maybe UnixMountPoint noUnixMountPoint = Nothing -- method UnixMountPoint::compare -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount2", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount2", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_compare" g_unix_mount_point_compare :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" Ptr UnixMountPoint -> -- mount2 : TInterface "Gio" "UnixMountPoint" IO Int32 unixMountPointCompare :: (MonadIO m) => UnixMountPoint -> -- _obj UnixMountPoint -> -- mount2 m Int32 unixMountPointCompare _obj mount2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let mount2' = unsafeManagedPtrGetPtr mount2 result <- g_unix_mount_point_compare _obj' mount2' touchManagedPtr _obj touchManagedPtr mount2 return result -- method UnixMountPoint::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_free" g_unix_mount_point_free :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO () unixMountPointFree :: (MonadIO m) => UnixMountPoint -> -- _obj m () unixMountPointFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_unix_mount_point_free _obj' touchManagedPtr _obj return () -- method UnixMountPoint::get_device_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_get_device_path" g_unix_mount_point_get_device_path :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CString unixMountPointGetDevicePath :: (MonadIO m) => UnixMountPoint -> -- _obj m T.Text unixMountPointGetDevicePath _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_get_device_path _obj' checkUnexpectedReturnNULL "g_unix_mount_point_get_device_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method UnixMountPoint::get_fs_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_get_fs_type" g_unix_mount_point_get_fs_type :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CString unixMountPointGetFsType :: (MonadIO m) => UnixMountPoint -> -- _obj m T.Text unixMountPointGetFsType _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_get_fs_type _obj' checkUnexpectedReturnNULL "g_unix_mount_point_get_fs_type" result result' <- cstringToText result touchManagedPtr _obj return result' -- method UnixMountPoint::get_mount_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_get_mount_path" g_unix_mount_point_get_mount_path :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CString unixMountPointGetMountPath :: (MonadIO m) => UnixMountPoint -> -- _obj m T.Text unixMountPointGetMountPath _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_get_mount_path _obj' checkUnexpectedReturnNULL "g_unix_mount_point_get_mount_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method UnixMountPoint::get_options -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_get_options" g_unix_mount_point_get_options :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CString unixMountPointGetOptions :: (MonadIO m) => UnixMountPoint -> -- _obj m T.Text unixMountPointGetOptions _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_get_options _obj' checkUnexpectedReturnNULL "g_unix_mount_point_get_options" result result' <- cstringToText result touchManagedPtr _obj return result' -- method UnixMountPoint::guess_can_eject -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_guess_can_eject" g_unix_mount_point_guess_can_eject :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CInt unixMountPointGuessCanEject :: (MonadIO m) => UnixMountPoint -> -- _obj m Bool unixMountPointGuessCanEject _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_guess_can_eject _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method UnixMountPoint::guess_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_guess_icon" g_unix_mount_point_guess_icon :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO (Ptr Icon) unixMountPointGuessIcon :: (MonadIO m) => UnixMountPoint -> -- _obj m Icon unixMountPointGuessIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_guess_icon _obj' checkUnexpectedReturnNULL "g_unix_mount_point_guess_icon" result result' <- (wrapObject Icon) result touchManagedPtr _obj return result' -- method UnixMountPoint::guess_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_guess_name" g_unix_mount_point_guess_name :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CString unixMountPointGuessName :: (MonadIO m) => UnixMountPoint -> -- _obj m T.Text unixMountPointGuessName _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_guess_name _obj' checkUnexpectedReturnNULL "g_unix_mount_point_guess_name" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method UnixMountPoint::guess_symbolic_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_guess_symbolic_icon" g_unix_mount_point_guess_symbolic_icon :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO (Ptr Icon) unixMountPointGuessSymbolicIcon :: (MonadIO m) => UnixMountPoint -> -- _obj m Icon unixMountPointGuessSymbolicIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_guess_symbolic_icon _obj' checkUnexpectedReturnNULL "g_unix_mount_point_guess_symbolic_icon" result result' <- (wrapObject Icon) result touchManagedPtr _obj return result' -- method UnixMountPoint::is_loopback -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_is_loopback" g_unix_mount_point_is_loopback :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CInt unixMountPointIsLoopback :: (MonadIO m) => UnixMountPoint -> -- _obj m Bool unixMountPointIsLoopback _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_is_loopback _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method UnixMountPoint::is_readonly -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_is_readonly" g_unix_mount_point_is_readonly :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CInt unixMountPointIsReadonly :: (MonadIO m) => UnixMountPoint -> -- _obj m Bool unixMountPointIsReadonly _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_is_readonly _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method UnixMountPoint::is_user_mountable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixMountPoint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_point_is_user_mountable" g_unix_mount_point_is_user_mountable :: Ptr UnixMountPoint -> -- _obj : TInterface "Gio" "UnixMountPoint" IO CInt unixMountPointIsUserMountable :: (MonadIO m) => UnixMountPoint -> -- _obj m Bool unixMountPointIsUserMountable _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_unix_mount_point_is_user_mountable _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- object UnixOutputStream newtype UnixOutputStream = UnixOutputStream (ForeignPtr UnixOutputStream) noUnixOutputStream :: Maybe UnixOutputStream noUnixOutputStream = Nothing foreign import ccall "g_unix_output_stream_get_type" c_g_unix_output_stream_get_type :: IO GType type instance ParentTypes UnixOutputStream = '[OutputStream, GObject.Object, FileDescriptorBased, PollableOutputStream] instance GObject UnixOutputStream where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_unix_output_stream_get_type class GObject o => UnixOutputStreamK o instance (GObject o, IsDescendantOf UnixOutputStream o) => UnixOutputStreamK o toUnixOutputStream :: UnixOutputStreamK o => o -> IO UnixOutputStream toUnixOutputStream = unsafeCastTo UnixOutputStream -- method UnixOutputStream::new -- method type : Constructor -- Args : [Arg {argName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_fd", 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 = "close_fd", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixOutputStream" -- throws : False -- Skip return : False foreign import ccall "g_unix_output_stream_new" g_unix_output_stream_new :: Int32 -> -- fd : TBasicType TInt32 CInt -> -- close_fd : TBasicType TBoolean IO (Ptr UnixOutputStream) unixOutputStreamNew :: (MonadIO m) => Int32 -> -- fd Bool -> -- close_fd m UnixOutputStream unixOutputStreamNew fd close_fd = liftIO $ do let close_fd' = (fromIntegral . fromEnum) close_fd result <- g_unix_output_stream_new fd close_fd' checkUnexpectedReturnNULL "g_unix_output_stream_new" result result' <- (wrapObject UnixOutputStream) result return result' -- method UnixOutputStream::get_close_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_output_stream_get_close_fd" g_unix_output_stream_get_close_fd :: Ptr UnixOutputStream -> -- _obj : TInterface "Gio" "UnixOutputStream" IO CInt unixOutputStreamGetCloseFd :: (MonadIO m, UnixOutputStreamK a) => a -> -- _obj m Bool unixOutputStreamGetCloseFd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_output_stream_get_close_fd _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method UnixOutputStream::get_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unix_output_stream_get_fd" g_unix_output_stream_get_fd :: Ptr UnixOutputStream -> -- _obj : TInterface "Gio" "UnixOutputStream" IO Int32 unixOutputStreamGetFd :: (MonadIO m, UnixOutputStreamK a) => a -> -- _obj m Int32 unixOutputStreamGetFd _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_output_stream_get_fd _obj' touchManagedPtr _obj return result -- method UnixOutputStream::set_close_fd -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_fd", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixOutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "close_fd", 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_unix_output_stream_set_close_fd" g_unix_output_stream_set_close_fd :: Ptr UnixOutputStream -> -- _obj : TInterface "Gio" "UnixOutputStream" CInt -> -- close_fd : TBasicType TBoolean IO () unixOutputStreamSetCloseFd :: (MonadIO m, UnixOutputStreamK a) => a -> -- _obj Bool -> -- close_fd m () unixOutputStreamSetCloseFd _obj close_fd = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let close_fd' = (fromIntegral . fromEnum) close_fd g_unix_output_stream_set_close_fd _obj' close_fd' touchManagedPtr _obj return () -- object UnixSocketAddress newtype UnixSocketAddress = UnixSocketAddress (ForeignPtr UnixSocketAddress) noUnixSocketAddress :: Maybe UnixSocketAddress noUnixSocketAddress = Nothing foreign import ccall "g_unix_socket_address_get_type" c_g_unix_socket_address_get_type :: IO GType type instance ParentTypes UnixSocketAddress = '[SocketAddress, GObject.Object, SocketConnectable] instance GObject UnixSocketAddress where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_unix_socket_address_get_type class GObject o => UnixSocketAddressK o instance (GObject o, IsDescendantOf UnixSocketAddress o) => UnixSocketAddressK o toUnixSocketAddress :: UnixSocketAddressK o => o -> IO UnixSocketAddress toUnixSocketAddress = unsafeCastTo UnixSocketAddress -- method UnixSocketAddress::new -- method type : Constructor -- 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 : TInterface "Gio" "UnixSocketAddress" -- throws : False -- Skip return : False foreign import ccall "g_unix_socket_address_new" g_unix_socket_address_new :: CString -> -- path : TBasicType TUTF8 IO (Ptr UnixSocketAddress) unixSocketAddressNew :: (MonadIO m) => T.Text -> -- path m UnixSocketAddress unixSocketAddressNew path = liftIO $ do path' <- textToCString path result <- g_unix_socket_address_new path' checkUnexpectedReturnNULL "g_unix_socket_address_new" result result' <- (wrapObject UnixSocketAddress) result freeMem path' return result' -- method UnixSocketAddress::new_abstract -- method type : Constructor -- Args : [Arg {argName = "path", argType = TCArray False (-1) 1 (TBasicType TInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "path_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "path", argType = TCArray False (-1) 1 (TBasicType TInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixSocketAddress" -- throws : False -- Skip return : False foreign import ccall "g_unix_socket_address_new_abstract" g_unix_socket_address_new_abstract :: Ptr Int8 -> -- path : TCArray False (-1) 1 (TBasicType TInt8) Int32 -> -- path_len : TBasicType TInt32 IO (Ptr UnixSocketAddress) {-# DEPRECATED unixSocketAddressNewAbstract ["Use g_unix_socket_address_new_with_type()."]#-} unixSocketAddressNewAbstract :: (MonadIO m) => [Int8] -> -- path m UnixSocketAddress unixSocketAddressNewAbstract path = liftIO $ do let path_len = fromIntegral $ length path path' <- packStorableArray path result <- g_unix_socket_address_new_abstract path' path_len checkUnexpectedReturnNULL "g_unix_socket_address_new_abstract" result result' <- (wrapObject UnixSocketAddress) result freeMem path' return result' -- method UnixSocketAddress::new_with_type -- method type : Constructor -- Args : [Arg {argName = "path", argType = TCArray False (-1) 1 (TBasicType TInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "UnixSocketAddressType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "path_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "path", argType = TCArray False (-1) 1 (TBasicType TInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "Gio" "UnixSocketAddressType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixSocketAddress" -- throws : False -- Skip return : False foreign import ccall "g_unix_socket_address_new_with_type" g_unix_socket_address_new_with_type :: Ptr Int8 -> -- path : TCArray False (-1) 1 (TBasicType TInt8) Int32 -> -- path_len : TBasicType TInt32 CUInt -> -- type : TInterface "Gio" "UnixSocketAddressType" IO (Ptr UnixSocketAddress) unixSocketAddressNewWithType :: (MonadIO m) => [Int8] -> -- path UnixSocketAddressType -> -- type m UnixSocketAddress unixSocketAddressNewWithType path type_ = liftIO $ do let path_len = fromIntegral $ length path path' <- packStorableArray path let type_' = (fromIntegral . fromEnum) type_ result <- g_unix_socket_address_new_with_type path' path_len type_' checkUnexpectedReturnNULL "g_unix_socket_address_new_with_type" result result' <- (wrapObject UnixSocketAddress) result freeMem path' return result' -- method UnixSocketAddress::get_address_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "UnixSocketAddressType" -- throws : False -- Skip return : False foreign import ccall "g_unix_socket_address_get_address_type" g_unix_socket_address_get_address_type :: Ptr UnixSocketAddress -> -- _obj : TInterface "Gio" "UnixSocketAddress" IO CUInt unixSocketAddressGetAddressType :: (MonadIO m, UnixSocketAddressK a) => a -> -- _obj m UnixSocketAddressType unixSocketAddressGetAddressType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_socket_address_get_address_type _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method UnixSocketAddress::get_is_abstract -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_socket_address_get_is_abstract" g_unix_socket_address_get_is_abstract :: Ptr UnixSocketAddress -> -- _obj : TInterface "Gio" "UnixSocketAddress" IO CInt {-# DEPRECATED unixSocketAddressGetIsAbstract ["Use g_unix_socket_address_get_address_type()"]#-} unixSocketAddressGetIsAbstract :: (MonadIO m, UnixSocketAddressK a) => a -> -- _obj m Bool unixSocketAddressGetIsAbstract _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_socket_address_get_is_abstract _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method UnixSocketAddress::get_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_socket_address_get_path" g_unix_socket_address_get_path :: Ptr UnixSocketAddress -> -- _obj : TInterface "Gio" "UnixSocketAddress" IO CString unixSocketAddressGetPath :: (MonadIO m, UnixSocketAddressK a) => a -> -- _obj m T.Text unixSocketAddressGetPath _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_socket_address_get_path _obj' checkUnexpectedReturnNULL "g_unix_socket_address_get_path" result result' <- cstringToText result touchManagedPtr _obj return result' -- method UnixSocketAddress::get_path_len -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "UnixSocketAddress", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_unix_socket_address_get_path_len" g_unix_socket_address_get_path_len :: Ptr UnixSocketAddress -> -- _obj : TInterface "Gio" "UnixSocketAddress" IO Word64 unixSocketAddressGetPathLen :: (MonadIO m, UnixSocketAddressK a) => a -> -- _obj m Word64 unixSocketAddressGetPathLen _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_unix_socket_address_get_path_len _obj' touchManagedPtr _obj return result -- method UnixSocketAddress::abstract_names_supported -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_socket_address_abstract_names_supported" g_unix_socket_address_abstract_names_supported :: IO CInt unixSocketAddressAbstractNamesSupported :: (MonadIO m) => m Bool unixSocketAddressAbstractNamesSupported = liftIO $ do result <- g_unix_socket_address_abstract_names_supported let result' = (/= 0) result return result' -- Enum UnixSocketAddressType data UnixSocketAddressType = UnixSocketAddressTypeInvalid | UnixSocketAddressTypeAnonymous | UnixSocketAddressTypePath | UnixSocketAddressTypeAbstract | UnixSocketAddressTypeAbstractPadded | AnotherUnixSocketAddressType Int deriving (Show, Eq) instance Enum UnixSocketAddressType where fromEnum UnixSocketAddressTypeInvalid = 0 fromEnum UnixSocketAddressTypeAnonymous = 1 fromEnum UnixSocketAddressTypePath = 2 fromEnum UnixSocketAddressTypeAbstract = 3 fromEnum UnixSocketAddressTypeAbstractPadded = 4 fromEnum (AnotherUnixSocketAddressType k) = k toEnum 0 = UnixSocketAddressTypeInvalid toEnum 1 = UnixSocketAddressTypeAnonymous toEnum 2 = UnixSocketAddressTypePath toEnum 3 = UnixSocketAddressTypeAbstract toEnum 4 = UnixSocketAddressTypeAbstractPadded toEnum k = AnotherUnixSocketAddressType k foreign import ccall "g_unix_socket_address_type_get_type" c_g_unix_socket_address_type_get_type :: IO GType instance BoxedEnum UnixSocketAddressType where boxedEnumType _ = c_g_unix_socket_address_type_get_type -- object Vfs newtype Vfs = Vfs (ForeignPtr Vfs) noVfs :: Maybe Vfs noVfs = Nothing foreign import ccall "g_vfs_get_type" c_g_vfs_get_type :: IO GType type instance ParentTypes Vfs = '[GObject.Object] instance GObject Vfs where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_vfs_get_type class GObject o => VfsK o instance (GObject o, IsDescendantOf Vfs o) => VfsK o toVfs :: VfsK o => o -> IO Vfs toVfs = unsafeCastTo Vfs -- method Vfs::get_file_for_path -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_vfs_get_file_for_path" g_vfs_get_file_for_path :: Ptr Vfs -> -- _obj : TInterface "Gio" "Vfs" CString -> -- path : TBasicType TUTF8 IO (Ptr File) vfsGetFileForPath :: (MonadIO m, VfsK a) => a -> -- _obj T.Text -> -- path m File vfsGetFileForPath _obj path = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj path' <- textToCString path result <- g_vfs_get_file_for_path _obj' path' checkUnexpectedReturnNULL "g_vfs_get_file_for_path" result result' <- (wrapObject File) result touchManagedPtr _obj freeMem path' return result' -- method Vfs::get_file_for_uri -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", 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 "Gio" "Vfs", 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 : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_vfs_get_file_for_uri" g_vfs_get_file_for_uri :: Ptr Vfs -> -- _obj : TInterface "Gio" "Vfs" CString -> -- uri : TBasicType TUTF8 IO (Ptr File) vfsGetFileForUri :: (MonadIO m, VfsK a) => a -> -- _obj T.Text -> -- uri m File vfsGetFileForUri _obj uri = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uri' <- textToCString uri result <- g_vfs_get_file_for_uri _obj' uri' checkUnexpectedReturnNULL "g_vfs_get_file_for_uri" result result' <- (wrapObject File) result touchManagedPtr _obj freeMem uri' return result' -- method Vfs::get_supported_uri_schemes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", 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_vfs_get_supported_uri_schemes" g_vfs_get_supported_uri_schemes :: Ptr Vfs -> -- _obj : TInterface "Gio" "Vfs" IO (Ptr CString) vfsGetSupportedUriSchemes :: (MonadIO m, VfsK a) => a -> -- _obj m [T.Text] vfsGetSupportedUriSchemes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_vfs_get_supported_uri_schemes _obj' checkUnexpectedReturnNULL "g_vfs_get_supported_uri_schemes" result result' <- unpackZeroTerminatedUTF8CArray result touchManagedPtr _obj return result' -- method Vfs::is_active -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_vfs_is_active" g_vfs_is_active :: Ptr Vfs -> -- _obj : TInterface "Gio" "Vfs" IO CInt vfsIsActive :: (MonadIO m, VfsK a) => a -> -- _obj m Bool vfsIsActive _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_vfs_is_active _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Vfs::parse_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parse_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Vfs", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parse_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_vfs_parse_name" g_vfs_parse_name :: Ptr Vfs -> -- _obj : TInterface "Gio" "Vfs" CString -> -- parse_name : TBasicType TUTF8 IO (Ptr File) vfsParseName :: (MonadIO m, VfsK a) => a -> -- _obj T.Text -> -- parse_name m File vfsParseName _obj parse_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj parse_name' <- textToCString parse_name result <- g_vfs_parse_name _obj' parse_name' checkUnexpectedReturnNULL "g_vfs_parse_name" result result' <- (wrapObject File) result touchManagedPtr _obj freeMem parse_name' return result' -- method Vfs::get_default -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "Vfs" -- throws : False -- Skip return : False foreign import ccall "g_vfs_get_default" g_vfs_get_default :: IO (Ptr Vfs) vfsGetDefault :: (MonadIO m) => m Vfs vfsGetDefault = liftIO $ do result <- g_vfs_get_default checkUnexpectedReturnNULL "g_vfs_get_default" result result' <- (newObject Vfs) result return result' -- method Vfs::get_local -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "Vfs" -- throws : False -- Skip return : False foreign import ccall "g_vfs_get_local" g_vfs_get_local :: IO (Ptr Vfs) vfsGetLocal :: (MonadIO m) => m Vfs vfsGetLocal = liftIO $ do result <- g_vfs_get_local checkUnexpectedReturnNULL "g_vfs_get_local" result result' <- (newObject Vfs) result return result' -- interface Volume newtype Volume = Volume (ForeignPtr Volume) noVolume :: Maybe Volume noVolume = Nothing foreign import ccall "g_volume_get_type" c_g_volume_get_type :: IO GType type instance ParentTypes Volume = '[GObject.Object] instance GObject Volume where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_volume_get_type class GObject o => VolumeK o instance (GObject o, IsDescendantOf Volume o) => VolumeK o toVolume :: VolumeK o => o -> IO Volume toVolume = unsafeCastTo Volume -- method Volume::can_eject -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_volume_can_eject" g_volume_can_eject :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO CInt volumeCanEject :: (MonadIO m, VolumeK a) => a -> -- _obj m Bool volumeCanEject _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_can_eject _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Volume::can_mount -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_volume_can_mount" g_volume_can_mount :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO CInt volumeCanMount :: (MonadIO m, VolumeK a) => a -> -- _obj m Bool volumeCanMount _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_can_mount _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Volume::eject -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, 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 "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_volume_eject" g_volume_eject :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () {-# DEPRECATED volumeEject ["(Since version 2.22)","Use g_volume_eject_with_operation() instead."]#-} volumeEject :: (MonadIO m, VolumeK a, CancellableK b) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () volumeEject _obj flags cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_volume_eject _obj' flags' maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust cancellable touchManagedPtr return () -- method Volume::eject_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_volume_eject_finish" g_volume_eject_finish :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt {-# DEPRECATED volumeEjectFinish ["(Since version 2.22)","Use g_volume_eject_with_operation_finish() instead."]#-} volumeEjectFinish :: (MonadIO m, VolumeK a, AsyncResultK b) => a -> -- _obj b -> -- result m () volumeEjectFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_volume_eject_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Volume::eject_with_operation -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountUnmountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_volume_eject_with_operation" g_volume_eject_with_operation :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" CUInt -> -- flags : TInterface "Gio" "MountUnmountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () volumeEjectWithOperation :: (MonadIO m, VolumeK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountUnmountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () volumeEjectWithOperation _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_volume_eject_with_operation _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Volume::eject_with_operation_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_volume_eject_with_operation_finish" g_volume_eject_with_operation_finish :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt volumeEjectWithOperationFinish :: (MonadIO m, VolumeK a, AsyncResultK b) => a -> -- _obj b -> -- result m () volumeEjectWithOperationFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_volume_eject_with_operation_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Volume::enumerate_identifiers -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", 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_volume_enumerate_identifiers" g_volume_enumerate_identifiers :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO (Ptr CString) volumeEnumerateIdentifiers :: (MonadIO m, VolumeK a) => a -> -- _obj m [T.Text] volumeEnumerateIdentifiers _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_enumerate_identifiers _obj' checkUnexpectedReturnNULL "g_volume_enumerate_identifiers" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr _obj return result' -- method Volume::get_activation_root -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_volume_get_activation_root" g_volume_get_activation_root :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO (Ptr File) volumeGetActivationRoot :: (MonadIO m, VolumeK a) => a -> -- _obj m File volumeGetActivationRoot _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_get_activation_root _obj' checkUnexpectedReturnNULL "g_volume_get_activation_root" result result' <- (wrapObject File) result touchManagedPtr _obj return result' -- method Volume::get_drive -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Drive" -- throws : False -- Skip return : False foreign import ccall "g_volume_get_drive" g_volume_get_drive :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO (Ptr Drive) volumeGetDrive :: (MonadIO m, VolumeK a) => a -> -- _obj m Drive volumeGetDrive _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_get_drive _obj' checkUnexpectedReturnNULL "g_volume_get_drive" result result' <- (wrapObject Drive) result touchManagedPtr _obj return result' -- method Volume::get_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_volume_get_icon" g_volume_get_icon :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO (Ptr Icon) volumeGetIcon :: (MonadIO m, VolumeK a) => a -> -- _obj m Icon volumeGetIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_get_icon _obj' checkUnexpectedReturnNULL "g_volume_get_icon" result result' <- (wrapObject Icon) result touchManagedPtr _obj return result' -- method Volume::get_identifier -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "kind", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "kind", 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_volume_get_identifier" g_volume_get_identifier :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" CString -> -- kind : TBasicType TUTF8 IO CString volumeGetIdentifier :: (MonadIO m, VolumeK a) => a -> -- _obj T.Text -> -- kind m T.Text volumeGetIdentifier _obj kind = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj kind' <- textToCString kind result <- g_volume_get_identifier _obj' kind' checkUnexpectedReturnNULL "g_volume_get_identifier" result result' <- cstringToText result freeMem result touchManagedPtr _obj freeMem kind' return result' -- method Volume::get_mount -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Mount" -- throws : False -- Skip return : False foreign import ccall "g_volume_get_mount" g_volume_get_mount :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO (Ptr Mount) volumeGetMount :: (MonadIO m, VolumeK a) => a -> -- _obj m Mount volumeGetMount _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_get_mount _obj' checkUnexpectedReturnNULL "g_volume_get_mount" result result' <- (wrapObject Mount) result touchManagedPtr _obj return result' -- method Volume::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_volume_get_name" g_volume_get_name :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO CString volumeGetName :: (MonadIO m, VolumeK a) => a -> -- _obj m T.Text volumeGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_get_name _obj' checkUnexpectedReturnNULL "g_volume_get_name" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method Volume::get_sort_key -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_volume_get_sort_key" g_volume_get_sort_key :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO CString volumeGetSortKey :: (MonadIO m, VolumeK a) => a -> -- _obj m T.Text volumeGetSortKey _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_get_sort_key _obj' checkUnexpectedReturnNULL "g_volume_get_sort_key" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Volume::get_symbolic_icon -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_volume_get_symbolic_icon" g_volume_get_symbolic_icon :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO (Ptr Icon) volumeGetSymbolicIcon :: (MonadIO m, VolumeK a) => a -> -- _obj m Icon volumeGetSymbolicIcon _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_get_symbolic_icon _obj' checkUnexpectedReturnNULL "g_volume_get_symbolic_icon" result result' <- (wrapObject Icon) result touchManagedPtr _obj return result' -- method Volume::get_uuid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_volume_get_uuid" g_volume_get_uuid :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO CString volumeGetUuid :: (MonadIO m, VolumeK a) => a -> -- _obj m T.Text volumeGetUuid _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_get_uuid _obj' checkUnexpectedReturnNULL "g_volume_get_uuid" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method Volume::mount -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountMountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", 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}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "MountMountFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount_operation", argType = TInterface "Gio" "MountOperation", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 5, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_volume_mount" g_volume_mount :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" CUInt -> -- flags : TInterface "Gio" "MountMountFlags" Ptr MountOperation -> -- mount_operation : TInterface "Gio" "MountOperation" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () volumeMount :: (MonadIO m, VolumeK a, MountOperationK b, CancellableK c) => a -> -- _obj [MountMountFlags] -> -- flags Maybe (b) -> -- mount_operation Maybe (c) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () volumeMount _obj flags mount_operation cancellable callback = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let flags' = gflagsToWord flags maybeMount_operation <- case mount_operation of Nothing -> return nullPtr Just jMount_operation -> do let jMount_operation' = unsafeManagedPtrCastPtr jMount_operation return jMount_operation' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_volume_mount _obj' flags' maybeMount_operation maybeCancellable maybeCallback user_data touchManagedPtr _obj whenJust mount_operation touchManagedPtr whenJust cancellable touchManagedPtr return () -- method Volume::mount_finish -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_volume_mount_finish" g_volume_mount_finish :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" Ptr AsyncResult -> -- result : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO CInt volumeMountFinish :: (MonadIO m, VolumeK a, AsyncResultK b) => a -> -- _obj b -> -- result m () volumeMountFinish _obj result_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let result_' = unsafeManagedPtrCastPtr result_ onException (do _ <- propagateGError $ g_volume_mount_finish _obj' result_' touchManagedPtr _obj touchManagedPtr result_ return () ) (do return () ) -- method Volume::should_automount -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Volume", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_volume_should_automount" g_volume_should_automount :: Ptr Volume -> -- _obj : TInterface "Gio" "Volume" IO CInt volumeShouldAutomount :: (MonadIO m, VolumeK a) => a -> -- _obj m Bool volumeShouldAutomount _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_should_automount _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- signal Volume::changed type VolumeChangedCallback = IO () noVolumeChangedCallback :: Maybe VolumeChangedCallback noVolumeChangedCallback = Nothing type VolumeChangedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeChangedCallback :: VolumeChangedCallbackC -> IO (FunPtr VolumeChangedCallbackC) volumeChangedClosure :: VolumeChangedCallback -> IO Closure volumeChangedClosure cb = newCClosure =<< mkVolumeChangedCallback wrapped where wrapped = volumeChangedCallbackWrapper cb volumeChangedCallbackWrapper :: VolumeChangedCallback -> Ptr () -> Ptr () -> IO () volumeChangedCallbackWrapper _cb _ _ = do _cb onVolumeChanged :: (GObject a, MonadIO m) => a -> VolumeChangedCallback -> m SignalHandlerId onVolumeChanged obj cb = liftIO $ connectVolumeChanged obj cb SignalConnectBefore afterVolumeChanged :: (GObject a, MonadIO m) => a -> VolumeChangedCallback -> m SignalHandlerId afterVolumeChanged obj cb = connectVolumeChanged obj cb SignalConnectAfter connectVolumeChanged :: (GObject a, MonadIO m) => a -> VolumeChangedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeChanged obj cb after = liftIO $ do cb' <- mkVolumeChangedCallback (volumeChangedCallbackWrapper cb) connectSignalFunPtr obj "changed" cb' after -- signal Volume::removed type VolumeRemovedCallback = IO () noVolumeRemovedCallback :: Maybe VolumeRemovedCallback noVolumeRemovedCallback = Nothing type VolumeRemovedCallbackC = Ptr () -> -- object Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeRemovedCallback :: VolumeRemovedCallbackC -> IO (FunPtr VolumeRemovedCallbackC) volumeRemovedClosure :: VolumeRemovedCallback -> IO Closure volumeRemovedClosure cb = newCClosure =<< mkVolumeRemovedCallback wrapped where wrapped = volumeRemovedCallbackWrapper cb volumeRemovedCallbackWrapper :: VolumeRemovedCallback -> Ptr () -> Ptr () -> IO () volumeRemovedCallbackWrapper _cb _ _ = do _cb onVolumeRemoved :: (GObject a, MonadIO m) => a -> VolumeRemovedCallback -> m SignalHandlerId onVolumeRemoved obj cb = liftIO $ connectVolumeRemoved obj cb SignalConnectBefore afterVolumeRemoved :: (GObject a, MonadIO m) => a -> VolumeRemovedCallback -> m SignalHandlerId afterVolumeRemoved obj cb = connectVolumeRemoved obj cb SignalConnectAfter connectVolumeRemoved :: (GObject a, MonadIO m) => a -> VolumeRemovedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeRemoved obj cb after = liftIO $ do cb' <- mkVolumeRemovedCallback (volumeRemovedCallbackWrapper cb) connectSignalFunPtr obj "removed" cb' after -- object VolumeMonitor newtype VolumeMonitor = VolumeMonitor (ForeignPtr VolumeMonitor) noVolumeMonitor :: Maybe VolumeMonitor noVolumeMonitor = Nothing foreign import ccall "g_volume_monitor_get_type" c_g_volume_monitor_get_type :: IO GType type instance ParentTypes VolumeMonitor = '[GObject.Object] instance GObject VolumeMonitor where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_volume_monitor_get_type class GObject o => VolumeMonitorK o instance (GObject o, IsDescendantOf VolumeMonitor o) => VolumeMonitorK o toVolumeMonitor :: VolumeMonitorK o => o -> IO VolumeMonitor toVolumeMonitor = unsafeCastTo VolumeMonitor -- method VolumeMonitor::get_connected_drives -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "Drive") -- throws : False -- Skip return : False foreign import ccall "g_volume_monitor_get_connected_drives" g_volume_monitor_get_connected_drives :: Ptr VolumeMonitor -> -- _obj : TInterface "Gio" "VolumeMonitor" IO (Ptr (GList (Ptr Drive))) volumeMonitorGetConnectedDrives :: (MonadIO m, VolumeMonitorK a) => a -> -- _obj m [Drive] volumeMonitorGetConnectedDrives _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_monitor_get_connected_drives _obj' checkUnexpectedReturnNULL "g_volume_monitor_get_connected_drives" result result' <- unpackGList result result'' <- mapM (wrapObject Drive) result' g_list_free result touchManagedPtr _obj return result'' -- method VolumeMonitor::get_mount_for_uuid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uuid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uuid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Mount" -- throws : False -- Skip return : False foreign import ccall "g_volume_monitor_get_mount_for_uuid" g_volume_monitor_get_mount_for_uuid :: Ptr VolumeMonitor -> -- _obj : TInterface "Gio" "VolumeMonitor" CString -> -- uuid : TBasicType TUTF8 IO (Ptr Mount) volumeMonitorGetMountForUuid :: (MonadIO m, VolumeMonitorK a) => a -> -- _obj T.Text -> -- uuid m Mount volumeMonitorGetMountForUuid _obj uuid = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uuid' <- textToCString uuid result <- g_volume_monitor_get_mount_for_uuid _obj' uuid' checkUnexpectedReturnNULL "g_volume_monitor_get_mount_for_uuid" result result' <- (wrapObject Mount) result touchManagedPtr _obj freeMem uuid' return result' -- method VolumeMonitor::get_mounts -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "Mount") -- throws : False -- Skip return : False foreign import ccall "g_volume_monitor_get_mounts" g_volume_monitor_get_mounts :: Ptr VolumeMonitor -> -- _obj : TInterface "Gio" "VolumeMonitor" IO (Ptr (GList (Ptr Mount))) volumeMonitorGetMounts :: (MonadIO m, VolumeMonitorK a) => a -> -- _obj m [Mount] volumeMonitorGetMounts _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_monitor_get_mounts _obj' checkUnexpectedReturnNULL "g_volume_monitor_get_mounts" result result' <- unpackGList result result'' <- mapM (wrapObject Mount) result' g_list_free result touchManagedPtr _obj return result'' -- method VolumeMonitor::get_volume_for_uuid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uuid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "uuid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Volume" -- throws : False -- Skip return : False foreign import ccall "g_volume_monitor_get_volume_for_uuid" g_volume_monitor_get_volume_for_uuid :: Ptr VolumeMonitor -> -- _obj : TInterface "Gio" "VolumeMonitor" CString -> -- uuid : TBasicType TUTF8 IO (Ptr Volume) volumeMonitorGetVolumeForUuid :: (MonadIO m, VolumeMonitorK a) => a -> -- _obj T.Text -> -- uuid m Volume volumeMonitorGetVolumeForUuid _obj uuid = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj uuid' <- textToCString uuid result <- g_volume_monitor_get_volume_for_uuid _obj' uuid' checkUnexpectedReturnNULL "g_volume_monitor_get_volume_for_uuid" result result' <- (wrapObject Volume) result touchManagedPtr _obj freeMem uuid' return result' -- method VolumeMonitor::get_volumes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "VolumeMonitor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "Volume") -- throws : False -- Skip return : False foreign import ccall "g_volume_monitor_get_volumes" g_volume_monitor_get_volumes :: Ptr VolumeMonitor -> -- _obj : TInterface "Gio" "VolumeMonitor" IO (Ptr (GList (Ptr Volume))) volumeMonitorGetVolumes :: (MonadIO m, VolumeMonitorK a) => a -> -- _obj m [Volume] volumeMonitorGetVolumes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_volume_monitor_get_volumes _obj' checkUnexpectedReturnNULL "g_volume_monitor_get_volumes" result result' <- unpackGList result result'' <- mapM (wrapObject Volume) result' g_list_free result touchManagedPtr _obj return result'' -- method VolumeMonitor::adopt_orphan_mount -- method type : MemberFunction -- Args : [Arg {argName = "mount", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount", argType = TInterface "Gio" "Mount", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Volume" -- throws : False -- Skip return : False foreign import ccall "g_volume_monitor_adopt_orphan_mount" g_volume_monitor_adopt_orphan_mount :: Ptr Mount -> -- mount : TInterface "Gio" "Mount" IO (Ptr Volume) {-# DEPRECATED volumeMonitorAdoptOrphanMount ["(Since version 2.20)","Instead of using this function, #GVolumeMonitor","implementations should instead create shadow mounts with the URI of","the mount they intend to adopt. See the proxy volume monitor in","gvfs for an example of this. Also see g_mount_is_shadowed(),","g_mount_shadow() and g_mount_unshadow() functions."]#-} volumeMonitorAdoptOrphanMount :: (MonadIO m, MountK a) => a -> -- mount m Volume volumeMonitorAdoptOrphanMount mount = liftIO $ do let mount' = unsafeManagedPtrCastPtr mount result <- g_volume_monitor_adopt_orphan_mount mount' checkUnexpectedReturnNULL "g_volume_monitor_adopt_orphan_mount" result result' <- (wrapObject Volume) result touchManagedPtr mount return result' -- method VolumeMonitor::get -- method type : MemberFunction -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "VolumeMonitor" -- throws : False -- Skip return : False foreign import ccall "g_volume_monitor_get" g_volume_monitor_get :: IO (Ptr VolumeMonitor) volumeMonitorGet :: (MonadIO m) => m VolumeMonitor volumeMonitorGet = liftIO $ do result <- g_volume_monitor_get checkUnexpectedReturnNULL "g_volume_monitor_get" result result' <- (wrapObject VolumeMonitor) result return result' -- signal VolumeMonitor::drive-changed type VolumeMonitorDriveChangedCallback = Drive -> IO () noVolumeMonitorDriveChangedCallback :: Maybe VolumeMonitorDriveChangedCallback noVolumeMonitorDriveChangedCallback = Nothing type VolumeMonitorDriveChangedCallbackC = Ptr () -> -- object Ptr Drive -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorDriveChangedCallback :: VolumeMonitorDriveChangedCallbackC -> IO (FunPtr VolumeMonitorDriveChangedCallbackC) volumeMonitorDriveChangedClosure :: VolumeMonitorDriveChangedCallback -> IO Closure volumeMonitorDriveChangedClosure cb = newCClosure =<< mkVolumeMonitorDriveChangedCallback wrapped where wrapped = volumeMonitorDriveChangedCallbackWrapper cb volumeMonitorDriveChangedCallbackWrapper :: VolumeMonitorDriveChangedCallback -> Ptr () -> Ptr Drive -> Ptr () -> IO () volumeMonitorDriveChangedCallbackWrapper _cb _ drive _ = do drive' <- (newObject Drive) drive _cb drive' onVolumeMonitorDriveChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveChangedCallback -> m SignalHandlerId onVolumeMonitorDriveChanged obj cb = liftIO $ connectVolumeMonitorDriveChanged obj cb SignalConnectBefore afterVolumeMonitorDriveChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveChangedCallback -> m SignalHandlerId afterVolumeMonitorDriveChanged obj cb = connectVolumeMonitorDriveChanged obj cb SignalConnectAfter connectVolumeMonitorDriveChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveChangedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorDriveChanged obj cb after = liftIO $ do cb' <- mkVolumeMonitorDriveChangedCallback (volumeMonitorDriveChangedCallbackWrapper cb) connectSignalFunPtr obj "drive-changed" cb' after -- signal VolumeMonitor::drive-connected type VolumeMonitorDriveConnectedCallback = Drive -> IO () noVolumeMonitorDriveConnectedCallback :: Maybe VolumeMonitorDriveConnectedCallback noVolumeMonitorDriveConnectedCallback = Nothing type VolumeMonitorDriveConnectedCallbackC = Ptr () -> -- object Ptr Drive -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorDriveConnectedCallback :: VolumeMonitorDriveConnectedCallbackC -> IO (FunPtr VolumeMonitorDriveConnectedCallbackC) volumeMonitorDriveConnectedClosure :: VolumeMonitorDriveConnectedCallback -> IO Closure volumeMonitorDriveConnectedClosure cb = newCClosure =<< mkVolumeMonitorDriveConnectedCallback wrapped where wrapped = volumeMonitorDriveConnectedCallbackWrapper cb volumeMonitorDriveConnectedCallbackWrapper :: VolumeMonitorDriveConnectedCallback -> Ptr () -> Ptr Drive -> Ptr () -> IO () volumeMonitorDriveConnectedCallbackWrapper _cb _ drive _ = do drive' <- (newObject Drive) drive _cb drive' onVolumeMonitorDriveConnected :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveConnectedCallback -> m SignalHandlerId onVolumeMonitorDriveConnected obj cb = liftIO $ connectVolumeMonitorDriveConnected obj cb SignalConnectBefore afterVolumeMonitorDriveConnected :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveConnectedCallback -> m SignalHandlerId afterVolumeMonitorDriveConnected obj cb = connectVolumeMonitorDriveConnected obj cb SignalConnectAfter connectVolumeMonitorDriveConnected :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveConnectedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorDriveConnected obj cb after = liftIO $ do cb' <- mkVolumeMonitorDriveConnectedCallback (volumeMonitorDriveConnectedCallbackWrapper cb) connectSignalFunPtr obj "drive-connected" cb' after -- signal VolumeMonitor::drive-disconnected type VolumeMonitorDriveDisconnectedCallback = Drive -> IO () noVolumeMonitorDriveDisconnectedCallback :: Maybe VolumeMonitorDriveDisconnectedCallback noVolumeMonitorDriveDisconnectedCallback = Nothing type VolumeMonitorDriveDisconnectedCallbackC = Ptr () -> -- object Ptr Drive -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorDriveDisconnectedCallback :: VolumeMonitorDriveDisconnectedCallbackC -> IO (FunPtr VolumeMonitorDriveDisconnectedCallbackC) volumeMonitorDriveDisconnectedClosure :: VolumeMonitorDriveDisconnectedCallback -> IO Closure volumeMonitorDriveDisconnectedClosure cb = newCClosure =<< mkVolumeMonitorDriveDisconnectedCallback wrapped where wrapped = volumeMonitorDriveDisconnectedCallbackWrapper cb volumeMonitorDriveDisconnectedCallbackWrapper :: VolumeMonitorDriveDisconnectedCallback -> Ptr () -> Ptr Drive -> Ptr () -> IO () volumeMonitorDriveDisconnectedCallbackWrapper _cb _ drive _ = do drive' <- (newObject Drive) drive _cb drive' onVolumeMonitorDriveDisconnected :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveDisconnectedCallback -> m SignalHandlerId onVolumeMonitorDriveDisconnected obj cb = liftIO $ connectVolumeMonitorDriveDisconnected obj cb SignalConnectBefore afterVolumeMonitorDriveDisconnected :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveDisconnectedCallback -> m SignalHandlerId afterVolumeMonitorDriveDisconnected obj cb = connectVolumeMonitorDriveDisconnected obj cb SignalConnectAfter connectVolumeMonitorDriveDisconnected :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveDisconnectedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorDriveDisconnected obj cb after = liftIO $ do cb' <- mkVolumeMonitorDriveDisconnectedCallback (volumeMonitorDriveDisconnectedCallbackWrapper cb) connectSignalFunPtr obj "drive-disconnected" cb' after -- signal VolumeMonitor::drive-eject-button type VolumeMonitorDriveEjectButtonCallback = Drive -> IO () noVolumeMonitorDriveEjectButtonCallback :: Maybe VolumeMonitorDriveEjectButtonCallback noVolumeMonitorDriveEjectButtonCallback = Nothing type VolumeMonitorDriveEjectButtonCallbackC = Ptr () -> -- object Ptr Drive -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorDriveEjectButtonCallback :: VolumeMonitorDriveEjectButtonCallbackC -> IO (FunPtr VolumeMonitorDriveEjectButtonCallbackC) volumeMonitorDriveEjectButtonClosure :: VolumeMonitorDriveEjectButtonCallback -> IO Closure volumeMonitorDriveEjectButtonClosure cb = newCClosure =<< mkVolumeMonitorDriveEjectButtonCallback wrapped where wrapped = volumeMonitorDriveEjectButtonCallbackWrapper cb volumeMonitorDriveEjectButtonCallbackWrapper :: VolumeMonitorDriveEjectButtonCallback -> Ptr () -> Ptr Drive -> Ptr () -> IO () volumeMonitorDriveEjectButtonCallbackWrapper _cb _ drive _ = do drive' <- (newObject Drive) drive _cb drive' onVolumeMonitorDriveEjectButton :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveEjectButtonCallback -> m SignalHandlerId onVolumeMonitorDriveEjectButton obj cb = liftIO $ connectVolumeMonitorDriveEjectButton obj cb SignalConnectBefore afterVolumeMonitorDriveEjectButton :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveEjectButtonCallback -> m SignalHandlerId afterVolumeMonitorDriveEjectButton obj cb = connectVolumeMonitorDriveEjectButton obj cb SignalConnectAfter connectVolumeMonitorDriveEjectButton :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveEjectButtonCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorDriveEjectButton obj cb after = liftIO $ do cb' <- mkVolumeMonitorDriveEjectButtonCallback (volumeMonitorDriveEjectButtonCallbackWrapper cb) connectSignalFunPtr obj "drive-eject-button" cb' after -- signal VolumeMonitor::drive-stop-button type VolumeMonitorDriveStopButtonCallback = Drive -> IO () noVolumeMonitorDriveStopButtonCallback :: Maybe VolumeMonitorDriveStopButtonCallback noVolumeMonitorDriveStopButtonCallback = Nothing type VolumeMonitorDriveStopButtonCallbackC = Ptr () -> -- object Ptr Drive -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorDriveStopButtonCallback :: VolumeMonitorDriveStopButtonCallbackC -> IO (FunPtr VolumeMonitorDriveStopButtonCallbackC) volumeMonitorDriveStopButtonClosure :: VolumeMonitorDriveStopButtonCallback -> IO Closure volumeMonitorDriveStopButtonClosure cb = newCClosure =<< mkVolumeMonitorDriveStopButtonCallback wrapped where wrapped = volumeMonitorDriveStopButtonCallbackWrapper cb volumeMonitorDriveStopButtonCallbackWrapper :: VolumeMonitorDriveStopButtonCallback -> Ptr () -> Ptr Drive -> Ptr () -> IO () volumeMonitorDriveStopButtonCallbackWrapper _cb _ drive _ = do drive' <- (newObject Drive) drive _cb drive' onVolumeMonitorDriveStopButton :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveStopButtonCallback -> m SignalHandlerId onVolumeMonitorDriveStopButton obj cb = liftIO $ connectVolumeMonitorDriveStopButton obj cb SignalConnectBefore afterVolumeMonitorDriveStopButton :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveStopButtonCallback -> m SignalHandlerId afterVolumeMonitorDriveStopButton obj cb = connectVolumeMonitorDriveStopButton obj cb SignalConnectAfter connectVolumeMonitorDriveStopButton :: (GObject a, MonadIO m) => a -> VolumeMonitorDriveStopButtonCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorDriveStopButton obj cb after = liftIO $ do cb' <- mkVolumeMonitorDriveStopButtonCallback (volumeMonitorDriveStopButtonCallbackWrapper cb) connectSignalFunPtr obj "drive-stop-button" cb' after -- signal VolumeMonitor::mount-added type VolumeMonitorMountAddedCallback = Mount -> IO () noVolumeMonitorMountAddedCallback :: Maybe VolumeMonitorMountAddedCallback noVolumeMonitorMountAddedCallback = Nothing type VolumeMonitorMountAddedCallbackC = Ptr () -> -- object Ptr Mount -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorMountAddedCallback :: VolumeMonitorMountAddedCallbackC -> IO (FunPtr VolumeMonitorMountAddedCallbackC) volumeMonitorMountAddedClosure :: VolumeMonitorMountAddedCallback -> IO Closure volumeMonitorMountAddedClosure cb = newCClosure =<< mkVolumeMonitorMountAddedCallback wrapped where wrapped = volumeMonitorMountAddedCallbackWrapper cb volumeMonitorMountAddedCallbackWrapper :: VolumeMonitorMountAddedCallback -> Ptr () -> Ptr Mount -> Ptr () -> IO () volumeMonitorMountAddedCallbackWrapper _cb _ mount _ = do mount' <- (newObject Mount) mount _cb mount' onVolumeMonitorMountAdded :: (GObject a, MonadIO m) => a -> VolumeMonitorMountAddedCallback -> m SignalHandlerId onVolumeMonitorMountAdded obj cb = liftIO $ connectVolumeMonitorMountAdded obj cb SignalConnectBefore afterVolumeMonitorMountAdded :: (GObject a, MonadIO m) => a -> VolumeMonitorMountAddedCallback -> m SignalHandlerId afterVolumeMonitorMountAdded obj cb = connectVolumeMonitorMountAdded obj cb SignalConnectAfter connectVolumeMonitorMountAdded :: (GObject a, MonadIO m) => a -> VolumeMonitorMountAddedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorMountAdded obj cb after = liftIO $ do cb' <- mkVolumeMonitorMountAddedCallback (volumeMonitorMountAddedCallbackWrapper cb) connectSignalFunPtr obj "mount-added" cb' after -- signal VolumeMonitor::mount-changed type VolumeMonitorMountChangedCallback = Mount -> IO () noVolumeMonitorMountChangedCallback :: Maybe VolumeMonitorMountChangedCallback noVolumeMonitorMountChangedCallback = Nothing type VolumeMonitorMountChangedCallbackC = Ptr () -> -- object Ptr Mount -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorMountChangedCallback :: VolumeMonitorMountChangedCallbackC -> IO (FunPtr VolumeMonitorMountChangedCallbackC) volumeMonitorMountChangedClosure :: VolumeMonitorMountChangedCallback -> IO Closure volumeMonitorMountChangedClosure cb = newCClosure =<< mkVolumeMonitorMountChangedCallback wrapped where wrapped = volumeMonitorMountChangedCallbackWrapper cb volumeMonitorMountChangedCallbackWrapper :: VolumeMonitorMountChangedCallback -> Ptr () -> Ptr Mount -> Ptr () -> IO () volumeMonitorMountChangedCallbackWrapper _cb _ mount _ = do mount' <- (newObject Mount) mount _cb mount' onVolumeMonitorMountChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorMountChangedCallback -> m SignalHandlerId onVolumeMonitorMountChanged obj cb = liftIO $ connectVolumeMonitorMountChanged obj cb SignalConnectBefore afterVolumeMonitorMountChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorMountChangedCallback -> m SignalHandlerId afterVolumeMonitorMountChanged obj cb = connectVolumeMonitorMountChanged obj cb SignalConnectAfter connectVolumeMonitorMountChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorMountChangedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorMountChanged obj cb after = liftIO $ do cb' <- mkVolumeMonitorMountChangedCallback (volumeMonitorMountChangedCallbackWrapper cb) connectSignalFunPtr obj "mount-changed" cb' after -- signal VolumeMonitor::mount-pre-unmount type VolumeMonitorMountPreUnmountCallback = Mount -> IO () noVolumeMonitorMountPreUnmountCallback :: Maybe VolumeMonitorMountPreUnmountCallback noVolumeMonitorMountPreUnmountCallback = Nothing type VolumeMonitorMountPreUnmountCallbackC = Ptr () -> -- object Ptr Mount -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorMountPreUnmountCallback :: VolumeMonitorMountPreUnmountCallbackC -> IO (FunPtr VolumeMonitorMountPreUnmountCallbackC) volumeMonitorMountPreUnmountClosure :: VolumeMonitorMountPreUnmountCallback -> IO Closure volumeMonitorMountPreUnmountClosure cb = newCClosure =<< mkVolumeMonitorMountPreUnmountCallback wrapped where wrapped = volumeMonitorMountPreUnmountCallbackWrapper cb volumeMonitorMountPreUnmountCallbackWrapper :: VolumeMonitorMountPreUnmountCallback -> Ptr () -> Ptr Mount -> Ptr () -> IO () volumeMonitorMountPreUnmountCallbackWrapper _cb _ mount _ = do mount' <- (newObject Mount) mount _cb mount' onVolumeMonitorMountPreUnmount :: (GObject a, MonadIO m) => a -> VolumeMonitorMountPreUnmountCallback -> m SignalHandlerId onVolumeMonitorMountPreUnmount obj cb = liftIO $ connectVolumeMonitorMountPreUnmount obj cb SignalConnectBefore afterVolumeMonitorMountPreUnmount :: (GObject a, MonadIO m) => a -> VolumeMonitorMountPreUnmountCallback -> m SignalHandlerId afterVolumeMonitorMountPreUnmount obj cb = connectVolumeMonitorMountPreUnmount obj cb SignalConnectAfter connectVolumeMonitorMountPreUnmount :: (GObject a, MonadIO m) => a -> VolumeMonitorMountPreUnmountCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorMountPreUnmount obj cb after = liftIO $ do cb' <- mkVolumeMonitorMountPreUnmountCallback (volumeMonitorMountPreUnmountCallbackWrapper cb) connectSignalFunPtr obj "mount-pre-unmount" cb' after -- signal VolumeMonitor::mount-removed type VolumeMonitorMountRemovedCallback = Mount -> IO () noVolumeMonitorMountRemovedCallback :: Maybe VolumeMonitorMountRemovedCallback noVolumeMonitorMountRemovedCallback = Nothing type VolumeMonitorMountRemovedCallbackC = Ptr () -> -- object Ptr Mount -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorMountRemovedCallback :: VolumeMonitorMountRemovedCallbackC -> IO (FunPtr VolumeMonitorMountRemovedCallbackC) volumeMonitorMountRemovedClosure :: VolumeMonitorMountRemovedCallback -> IO Closure volumeMonitorMountRemovedClosure cb = newCClosure =<< mkVolumeMonitorMountRemovedCallback wrapped where wrapped = volumeMonitorMountRemovedCallbackWrapper cb volumeMonitorMountRemovedCallbackWrapper :: VolumeMonitorMountRemovedCallback -> Ptr () -> Ptr Mount -> Ptr () -> IO () volumeMonitorMountRemovedCallbackWrapper _cb _ mount _ = do mount' <- (newObject Mount) mount _cb mount' onVolumeMonitorMountRemoved :: (GObject a, MonadIO m) => a -> VolumeMonitorMountRemovedCallback -> m SignalHandlerId onVolumeMonitorMountRemoved obj cb = liftIO $ connectVolumeMonitorMountRemoved obj cb SignalConnectBefore afterVolumeMonitorMountRemoved :: (GObject a, MonadIO m) => a -> VolumeMonitorMountRemovedCallback -> m SignalHandlerId afterVolumeMonitorMountRemoved obj cb = connectVolumeMonitorMountRemoved obj cb SignalConnectAfter connectVolumeMonitorMountRemoved :: (GObject a, MonadIO m) => a -> VolumeMonitorMountRemovedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorMountRemoved obj cb after = liftIO $ do cb' <- mkVolumeMonitorMountRemovedCallback (volumeMonitorMountRemovedCallbackWrapper cb) connectSignalFunPtr obj "mount-removed" cb' after -- signal VolumeMonitor::volume-added type VolumeMonitorVolumeAddedCallback = Volume -> IO () noVolumeMonitorVolumeAddedCallback :: Maybe VolumeMonitorVolumeAddedCallback noVolumeMonitorVolumeAddedCallback = Nothing type VolumeMonitorVolumeAddedCallbackC = Ptr () -> -- object Ptr Volume -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorVolumeAddedCallback :: VolumeMonitorVolumeAddedCallbackC -> IO (FunPtr VolumeMonitorVolumeAddedCallbackC) volumeMonitorVolumeAddedClosure :: VolumeMonitorVolumeAddedCallback -> IO Closure volumeMonitorVolumeAddedClosure cb = newCClosure =<< mkVolumeMonitorVolumeAddedCallback wrapped where wrapped = volumeMonitorVolumeAddedCallbackWrapper cb volumeMonitorVolumeAddedCallbackWrapper :: VolumeMonitorVolumeAddedCallback -> Ptr () -> Ptr Volume -> Ptr () -> IO () volumeMonitorVolumeAddedCallbackWrapper _cb _ volume _ = do volume' <- (newObject Volume) volume _cb volume' onVolumeMonitorVolumeAdded :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeAddedCallback -> m SignalHandlerId onVolumeMonitorVolumeAdded obj cb = liftIO $ connectVolumeMonitorVolumeAdded obj cb SignalConnectBefore afterVolumeMonitorVolumeAdded :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeAddedCallback -> m SignalHandlerId afterVolumeMonitorVolumeAdded obj cb = connectVolumeMonitorVolumeAdded obj cb SignalConnectAfter connectVolumeMonitorVolumeAdded :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeAddedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorVolumeAdded obj cb after = liftIO $ do cb' <- mkVolumeMonitorVolumeAddedCallback (volumeMonitorVolumeAddedCallbackWrapper cb) connectSignalFunPtr obj "volume-added" cb' after -- signal VolumeMonitor::volume-changed type VolumeMonitorVolumeChangedCallback = Volume -> IO () noVolumeMonitorVolumeChangedCallback :: Maybe VolumeMonitorVolumeChangedCallback noVolumeMonitorVolumeChangedCallback = Nothing type VolumeMonitorVolumeChangedCallbackC = Ptr () -> -- object Ptr Volume -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorVolumeChangedCallback :: VolumeMonitorVolumeChangedCallbackC -> IO (FunPtr VolumeMonitorVolumeChangedCallbackC) volumeMonitorVolumeChangedClosure :: VolumeMonitorVolumeChangedCallback -> IO Closure volumeMonitorVolumeChangedClosure cb = newCClosure =<< mkVolumeMonitorVolumeChangedCallback wrapped where wrapped = volumeMonitorVolumeChangedCallbackWrapper cb volumeMonitorVolumeChangedCallbackWrapper :: VolumeMonitorVolumeChangedCallback -> Ptr () -> Ptr Volume -> Ptr () -> IO () volumeMonitorVolumeChangedCallbackWrapper _cb _ volume _ = do volume' <- (newObject Volume) volume _cb volume' onVolumeMonitorVolumeChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeChangedCallback -> m SignalHandlerId onVolumeMonitorVolumeChanged obj cb = liftIO $ connectVolumeMonitorVolumeChanged obj cb SignalConnectBefore afterVolumeMonitorVolumeChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeChangedCallback -> m SignalHandlerId afterVolumeMonitorVolumeChanged obj cb = connectVolumeMonitorVolumeChanged obj cb SignalConnectAfter connectVolumeMonitorVolumeChanged :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeChangedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorVolumeChanged obj cb after = liftIO $ do cb' <- mkVolumeMonitorVolumeChangedCallback (volumeMonitorVolumeChangedCallbackWrapper cb) connectSignalFunPtr obj "volume-changed" cb' after -- signal VolumeMonitor::volume-removed type VolumeMonitorVolumeRemovedCallback = Volume -> IO () noVolumeMonitorVolumeRemovedCallback :: Maybe VolumeMonitorVolumeRemovedCallback noVolumeMonitorVolumeRemovedCallback = Nothing type VolumeMonitorVolumeRemovedCallbackC = Ptr () -> -- object Ptr Volume -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkVolumeMonitorVolumeRemovedCallback :: VolumeMonitorVolumeRemovedCallbackC -> IO (FunPtr VolumeMonitorVolumeRemovedCallbackC) volumeMonitorVolumeRemovedClosure :: VolumeMonitorVolumeRemovedCallback -> IO Closure volumeMonitorVolumeRemovedClosure cb = newCClosure =<< mkVolumeMonitorVolumeRemovedCallback wrapped where wrapped = volumeMonitorVolumeRemovedCallbackWrapper cb volumeMonitorVolumeRemovedCallbackWrapper :: VolumeMonitorVolumeRemovedCallback -> Ptr () -> Ptr Volume -> Ptr () -> IO () volumeMonitorVolumeRemovedCallbackWrapper _cb _ volume _ = do volume' <- (newObject Volume) volume _cb volume' onVolumeMonitorVolumeRemoved :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeRemovedCallback -> m SignalHandlerId onVolumeMonitorVolumeRemoved obj cb = liftIO $ connectVolumeMonitorVolumeRemoved obj cb SignalConnectBefore afterVolumeMonitorVolumeRemoved :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeRemovedCallback -> m SignalHandlerId afterVolumeMonitorVolumeRemoved obj cb = connectVolumeMonitorVolumeRemoved obj cb SignalConnectAfter connectVolumeMonitorVolumeRemoved :: (GObject a, MonadIO m) => a -> VolumeMonitorVolumeRemovedCallback -> SignalConnectMode -> m SignalHandlerId connectVolumeMonitorVolumeRemoved obj cb after = liftIO $ do cb' <- mkVolumeMonitorVolumeRemovedCallback (volumeMonitorVolumeRemovedCallbackWrapper cb) connectSignalFunPtr obj "volume-removed" cb' after -- object ZlibCompressor newtype ZlibCompressor = ZlibCompressor (ForeignPtr ZlibCompressor) noZlibCompressor :: Maybe ZlibCompressor noZlibCompressor = Nothing foreign import ccall "g_zlib_compressor_get_type" c_g_zlib_compressor_get_type :: IO GType type instance ParentTypes ZlibCompressor = '[GObject.Object, Converter] instance GObject ZlibCompressor where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_zlib_compressor_get_type class GObject o => ZlibCompressorK o instance (GObject o, IsDescendantOf ZlibCompressor o) => ZlibCompressorK o toZlibCompressor :: ZlibCompressorK o => o -> IO ZlibCompressor toZlibCompressor = unsafeCastTo ZlibCompressor -- method ZlibCompressor::new -- method type : Constructor -- Args : [Arg {argName = "format", argType = TInterface "Gio" "ZlibCompressorFormat", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "format", argType = TInterface "Gio" "ZlibCompressorFormat", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ZlibCompressor" -- throws : False -- Skip return : False foreign import ccall "g_zlib_compressor_new" g_zlib_compressor_new :: CUInt -> -- format : TInterface "Gio" "ZlibCompressorFormat" Int32 -> -- level : TBasicType TInt32 IO (Ptr ZlibCompressor) zlibCompressorNew :: (MonadIO m) => ZlibCompressorFormat -> -- format Int32 -> -- level m ZlibCompressor zlibCompressorNew format level = liftIO $ do let format' = (fromIntegral . fromEnum) format result <- g_zlib_compressor_new format' level checkUnexpectedReturnNULL "g_zlib_compressor_new" result result' <- (wrapObject ZlibCompressor) result return result' -- method ZlibCompressor::get_file_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ZlibCompressor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ZlibCompressor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : False -- Skip return : False foreign import ccall "g_zlib_compressor_get_file_info" g_zlib_compressor_get_file_info :: Ptr ZlibCompressor -> -- _obj : TInterface "Gio" "ZlibCompressor" IO (Ptr FileInfo) zlibCompressorGetFileInfo :: (MonadIO m, ZlibCompressorK a) => a -> -- _obj m FileInfo zlibCompressorGetFileInfo _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_zlib_compressor_get_file_info _obj' checkUnexpectedReturnNULL "g_zlib_compressor_get_file_info" result result' <- (newObject FileInfo) result touchManagedPtr _obj return result' -- method ZlibCompressor::set_file_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ZlibCompressor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file_info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ZlibCompressor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "file_info", argType = TInterface "Gio" "FileInfo", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_zlib_compressor_set_file_info" g_zlib_compressor_set_file_info :: Ptr ZlibCompressor -> -- _obj : TInterface "Gio" "ZlibCompressor" Ptr FileInfo -> -- file_info : TInterface "Gio" "FileInfo" IO () zlibCompressorSetFileInfo :: (MonadIO m, ZlibCompressorK a, FileInfoK b) => a -> -- _obj Maybe (b) -> -- file_info m () zlibCompressorSetFileInfo _obj file_info = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeFile_info <- case file_info of Nothing -> return nullPtr Just jFile_info -> do let jFile_info' = unsafeManagedPtrCastPtr jFile_info return jFile_info' g_zlib_compressor_set_file_info _obj' maybeFile_info touchManagedPtr _obj whenJust file_info touchManagedPtr return () -- Enum ZlibCompressorFormat data ZlibCompressorFormat = ZlibCompressorFormatZlib | ZlibCompressorFormatGzip | ZlibCompressorFormatRaw | AnotherZlibCompressorFormat Int deriving (Show, Eq) instance Enum ZlibCompressorFormat where fromEnum ZlibCompressorFormatZlib = 0 fromEnum ZlibCompressorFormatGzip = 1 fromEnum ZlibCompressorFormatRaw = 2 fromEnum (AnotherZlibCompressorFormat k) = k toEnum 0 = ZlibCompressorFormatZlib toEnum 1 = ZlibCompressorFormatGzip toEnum 2 = ZlibCompressorFormatRaw toEnum k = AnotherZlibCompressorFormat k foreign import ccall "g_zlib_compressor_format_get_type" c_g_zlib_compressor_format_get_type :: IO GType instance BoxedEnum ZlibCompressorFormat where boxedEnumType _ = c_g_zlib_compressor_format_get_type -- object ZlibDecompressor newtype ZlibDecompressor = ZlibDecompressor (ForeignPtr ZlibDecompressor) noZlibDecompressor :: Maybe ZlibDecompressor noZlibDecompressor = Nothing foreign import ccall "g_zlib_decompressor_get_type" c_g_zlib_decompressor_get_type :: IO GType type instance ParentTypes ZlibDecompressor = '[GObject.Object, Converter] instance GObject ZlibDecompressor where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_zlib_decompressor_get_type class GObject o => ZlibDecompressorK o instance (GObject o, IsDescendantOf ZlibDecompressor o) => ZlibDecompressorK o toZlibDecompressor :: ZlibDecompressorK o => o -> IO ZlibDecompressor toZlibDecompressor = unsafeCastTo ZlibDecompressor -- method ZlibDecompressor::new -- method type : Constructor -- Args : [Arg {argName = "format", argType = TInterface "Gio" "ZlibCompressorFormat", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "format", argType = TInterface "Gio" "ZlibCompressorFormat", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "ZlibDecompressor" -- throws : False -- Skip return : False foreign import ccall "g_zlib_decompressor_new" g_zlib_decompressor_new :: CUInt -> -- format : TInterface "Gio" "ZlibCompressorFormat" IO (Ptr ZlibDecompressor) zlibDecompressorNew :: (MonadIO m) => ZlibCompressorFormat -> -- format m ZlibDecompressor zlibDecompressorNew format = liftIO $ do let format' = (fromIntegral . fromEnum) format result <- g_zlib_decompressor_new format' checkUnexpectedReturnNULL "g_zlib_decompressor_new" result result' <- (wrapObject ZlibDecompressor) result return result' -- method ZlibDecompressor::get_file_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "ZlibDecompressor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "ZlibDecompressor", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "FileInfo" -- throws : False -- Skip return : False foreign import ccall "g_zlib_decompressor_get_file_info" g_zlib_decompressor_get_file_info :: Ptr ZlibDecompressor -> -- _obj : TInterface "Gio" "ZlibDecompressor" IO (Ptr FileInfo) zlibDecompressorGetFileInfo :: (MonadIO m, ZlibDecompressorK a) => a -> -- _obj m FileInfo zlibDecompressorGetFileInfo _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_zlib_decompressor_get_file_info _obj' checkUnexpectedReturnNULL "g_zlib_decompressor_get_file_info" result result' <- (newObject FileInfo) result touchManagedPtr _obj return result' -- constant _DESKTOP_APP_INFO_LOOKUP_EXTENSION_POINT_NAME _DESKTOP_APP_INFO_LOOKUP_EXTENSION_POINT_NAME :: T.Text _DESKTOP_APP_INFO_LOOKUP_EXTENSION_POINT_NAME = "gio-desktop-app-info-lookup" -- constant _FILE_ATTRIBUTE_ACCESS_CAN_DELETE _FILE_ATTRIBUTE_ACCESS_CAN_DELETE :: T.Text _FILE_ATTRIBUTE_ACCESS_CAN_DELETE = "access::can-delete" -- constant _FILE_ATTRIBUTE_ACCESS_CAN_EXECUTE _FILE_ATTRIBUTE_ACCESS_CAN_EXECUTE :: T.Text _FILE_ATTRIBUTE_ACCESS_CAN_EXECUTE = "access::can-execute" -- constant _FILE_ATTRIBUTE_ACCESS_CAN_READ _FILE_ATTRIBUTE_ACCESS_CAN_READ :: T.Text _FILE_ATTRIBUTE_ACCESS_CAN_READ = "access::can-read" -- constant _FILE_ATTRIBUTE_ACCESS_CAN_RENAME _FILE_ATTRIBUTE_ACCESS_CAN_RENAME :: T.Text _FILE_ATTRIBUTE_ACCESS_CAN_RENAME = "access::can-rename" -- constant _FILE_ATTRIBUTE_ACCESS_CAN_TRASH _FILE_ATTRIBUTE_ACCESS_CAN_TRASH :: T.Text _FILE_ATTRIBUTE_ACCESS_CAN_TRASH = "access::can-trash" -- constant _FILE_ATTRIBUTE_ACCESS_CAN_WRITE _FILE_ATTRIBUTE_ACCESS_CAN_WRITE :: T.Text _FILE_ATTRIBUTE_ACCESS_CAN_WRITE = "access::can-write" -- constant _FILE_ATTRIBUTE_DOS_IS_ARCHIVE _FILE_ATTRIBUTE_DOS_IS_ARCHIVE :: T.Text _FILE_ATTRIBUTE_DOS_IS_ARCHIVE = "dos::is-archive" -- constant _FILE_ATTRIBUTE_DOS_IS_SYSTEM _FILE_ATTRIBUTE_DOS_IS_SYSTEM :: T.Text _FILE_ATTRIBUTE_DOS_IS_SYSTEM = "dos::is-system" -- constant _FILE_ATTRIBUTE_ETAG_VALUE _FILE_ATTRIBUTE_ETAG_VALUE :: T.Text _FILE_ATTRIBUTE_ETAG_VALUE = "etag::value" -- constant _FILE_ATTRIBUTE_FILESYSTEM_FREE _FILE_ATTRIBUTE_FILESYSTEM_FREE :: T.Text _FILE_ATTRIBUTE_FILESYSTEM_FREE = "filesystem::free" -- constant _FILE_ATTRIBUTE_FILESYSTEM_READONLY _FILE_ATTRIBUTE_FILESYSTEM_READONLY :: T.Text _FILE_ATTRIBUTE_FILESYSTEM_READONLY = "filesystem::readonly" -- constant _FILE_ATTRIBUTE_FILESYSTEM_SIZE _FILE_ATTRIBUTE_FILESYSTEM_SIZE :: T.Text _FILE_ATTRIBUTE_FILESYSTEM_SIZE = "filesystem::size" -- constant _FILE_ATTRIBUTE_FILESYSTEM_TYPE _FILE_ATTRIBUTE_FILESYSTEM_TYPE :: T.Text _FILE_ATTRIBUTE_FILESYSTEM_TYPE = "filesystem::type" -- constant _FILE_ATTRIBUTE_FILESYSTEM_USED _FILE_ATTRIBUTE_FILESYSTEM_USED :: T.Text _FILE_ATTRIBUTE_FILESYSTEM_USED = "filesystem::used" -- constant _FILE_ATTRIBUTE_FILESYSTEM_USE_PREVIEW _FILE_ATTRIBUTE_FILESYSTEM_USE_PREVIEW :: T.Text _FILE_ATTRIBUTE_FILESYSTEM_USE_PREVIEW = "filesystem::use-preview" -- constant _FILE_ATTRIBUTE_GVFS_BACKEND _FILE_ATTRIBUTE_GVFS_BACKEND :: T.Text _FILE_ATTRIBUTE_GVFS_BACKEND = "gvfs::backend" -- constant _FILE_ATTRIBUTE_ID_FILE _FILE_ATTRIBUTE_ID_FILE :: T.Text _FILE_ATTRIBUTE_ID_FILE = "id::file" -- constant _FILE_ATTRIBUTE_ID_FILESYSTEM _FILE_ATTRIBUTE_ID_FILESYSTEM :: T.Text _FILE_ATTRIBUTE_ID_FILESYSTEM = "id::filesystem" -- constant _FILE_ATTRIBUTE_MOUNTABLE_CAN_EJECT _FILE_ATTRIBUTE_MOUNTABLE_CAN_EJECT :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_CAN_EJECT = "mountable::can-eject" -- constant _FILE_ATTRIBUTE_MOUNTABLE_CAN_MOUNT _FILE_ATTRIBUTE_MOUNTABLE_CAN_MOUNT :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_CAN_MOUNT = "mountable::can-mount" -- constant _FILE_ATTRIBUTE_MOUNTABLE_CAN_POLL _FILE_ATTRIBUTE_MOUNTABLE_CAN_POLL :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_CAN_POLL = "mountable::can-poll" -- constant _FILE_ATTRIBUTE_MOUNTABLE_CAN_START _FILE_ATTRIBUTE_MOUNTABLE_CAN_START :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_CAN_START = "mountable::can-start" -- constant _FILE_ATTRIBUTE_MOUNTABLE_CAN_START_DEGRADED _FILE_ATTRIBUTE_MOUNTABLE_CAN_START_DEGRADED :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_CAN_START_DEGRADED = "mountable::can-start-degraded" -- constant _FILE_ATTRIBUTE_MOUNTABLE_CAN_STOP _FILE_ATTRIBUTE_MOUNTABLE_CAN_STOP :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_CAN_STOP = "mountable::can-stop" -- constant _FILE_ATTRIBUTE_MOUNTABLE_CAN_UNMOUNT _FILE_ATTRIBUTE_MOUNTABLE_CAN_UNMOUNT :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_CAN_UNMOUNT = "mountable::can-unmount" -- constant _FILE_ATTRIBUTE_MOUNTABLE_HAL_UDI _FILE_ATTRIBUTE_MOUNTABLE_HAL_UDI :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_HAL_UDI = "mountable::hal-udi" -- constant _FILE_ATTRIBUTE_MOUNTABLE_IS_MEDIA_CHECK_AUTOMATIC _FILE_ATTRIBUTE_MOUNTABLE_IS_MEDIA_CHECK_AUTOMATIC :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_IS_MEDIA_CHECK_AUTOMATIC = "mountable::is-media-check-automatic" -- constant _FILE_ATTRIBUTE_MOUNTABLE_START_STOP_TYPE _FILE_ATTRIBUTE_MOUNTABLE_START_STOP_TYPE :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_START_STOP_TYPE = "mountable::start-stop-type" -- constant _FILE_ATTRIBUTE_MOUNTABLE_UNIX_DEVICE _FILE_ATTRIBUTE_MOUNTABLE_UNIX_DEVICE :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_UNIX_DEVICE = "mountable::unix-device" -- constant _FILE_ATTRIBUTE_MOUNTABLE_UNIX_DEVICE_FILE _FILE_ATTRIBUTE_MOUNTABLE_UNIX_DEVICE_FILE :: T.Text _FILE_ATTRIBUTE_MOUNTABLE_UNIX_DEVICE_FILE = "mountable::unix-device-file" -- constant _FILE_ATTRIBUTE_OWNER_GROUP _FILE_ATTRIBUTE_OWNER_GROUP :: T.Text _FILE_ATTRIBUTE_OWNER_GROUP = "owner::group" -- constant _FILE_ATTRIBUTE_OWNER_USER _FILE_ATTRIBUTE_OWNER_USER :: T.Text _FILE_ATTRIBUTE_OWNER_USER = "owner::user" -- constant _FILE_ATTRIBUTE_OWNER_USER_REAL _FILE_ATTRIBUTE_OWNER_USER_REAL :: T.Text _FILE_ATTRIBUTE_OWNER_USER_REAL = "owner::user-real" -- constant _FILE_ATTRIBUTE_PREVIEW_ICON _FILE_ATTRIBUTE_PREVIEW_ICON :: T.Text _FILE_ATTRIBUTE_PREVIEW_ICON = "preview::icon" -- constant _FILE_ATTRIBUTE_SELINUX_CONTEXT _FILE_ATTRIBUTE_SELINUX_CONTEXT :: T.Text _FILE_ATTRIBUTE_SELINUX_CONTEXT = "selinux::context" -- constant _FILE_ATTRIBUTE_STANDARD_ALLOCATED_SIZE _FILE_ATTRIBUTE_STANDARD_ALLOCATED_SIZE :: T.Text _FILE_ATTRIBUTE_STANDARD_ALLOCATED_SIZE = "standard::allocated-size" -- constant _FILE_ATTRIBUTE_STANDARD_CONTENT_TYPE _FILE_ATTRIBUTE_STANDARD_CONTENT_TYPE :: T.Text _FILE_ATTRIBUTE_STANDARD_CONTENT_TYPE = "standard::content-type" -- constant _FILE_ATTRIBUTE_STANDARD_COPY_NAME _FILE_ATTRIBUTE_STANDARD_COPY_NAME :: T.Text _FILE_ATTRIBUTE_STANDARD_COPY_NAME = "standard::copy-name" -- constant _FILE_ATTRIBUTE_STANDARD_DESCRIPTION _FILE_ATTRIBUTE_STANDARD_DESCRIPTION :: T.Text _FILE_ATTRIBUTE_STANDARD_DESCRIPTION = "standard::description" -- constant _FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME _FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME :: T.Text _FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME = "standard::display-name" -- constant _FILE_ATTRIBUTE_STANDARD_EDIT_NAME _FILE_ATTRIBUTE_STANDARD_EDIT_NAME :: T.Text _FILE_ATTRIBUTE_STANDARD_EDIT_NAME = "standard::edit-name" -- constant _FILE_ATTRIBUTE_STANDARD_FAST_CONTENT_TYPE _FILE_ATTRIBUTE_STANDARD_FAST_CONTENT_TYPE :: T.Text _FILE_ATTRIBUTE_STANDARD_FAST_CONTENT_TYPE = "standard::fast-content-type" -- constant _FILE_ATTRIBUTE_STANDARD_ICON _FILE_ATTRIBUTE_STANDARD_ICON :: T.Text _FILE_ATTRIBUTE_STANDARD_ICON = "standard::icon" -- constant _FILE_ATTRIBUTE_STANDARD_IS_BACKUP _FILE_ATTRIBUTE_STANDARD_IS_BACKUP :: T.Text _FILE_ATTRIBUTE_STANDARD_IS_BACKUP = "standard::is-backup" -- constant _FILE_ATTRIBUTE_STANDARD_IS_HIDDEN _FILE_ATTRIBUTE_STANDARD_IS_HIDDEN :: T.Text _FILE_ATTRIBUTE_STANDARD_IS_HIDDEN = "standard::is-hidden" -- constant _FILE_ATTRIBUTE_STANDARD_IS_SYMLINK _FILE_ATTRIBUTE_STANDARD_IS_SYMLINK :: T.Text _FILE_ATTRIBUTE_STANDARD_IS_SYMLINK = "standard::is-symlink" -- constant _FILE_ATTRIBUTE_STANDARD_IS_VIRTUAL _FILE_ATTRIBUTE_STANDARD_IS_VIRTUAL :: T.Text _FILE_ATTRIBUTE_STANDARD_IS_VIRTUAL = "standard::is-virtual" -- constant _FILE_ATTRIBUTE_STANDARD_NAME _FILE_ATTRIBUTE_STANDARD_NAME :: T.Text _FILE_ATTRIBUTE_STANDARD_NAME = "standard::name" -- constant _FILE_ATTRIBUTE_STANDARD_SIZE _FILE_ATTRIBUTE_STANDARD_SIZE :: T.Text _FILE_ATTRIBUTE_STANDARD_SIZE = "standard::size" -- constant _FILE_ATTRIBUTE_STANDARD_SORT_ORDER _FILE_ATTRIBUTE_STANDARD_SORT_ORDER :: T.Text _FILE_ATTRIBUTE_STANDARD_SORT_ORDER = "standard::sort-order" -- constant _FILE_ATTRIBUTE_STANDARD_SYMBOLIC_ICON _FILE_ATTRIBUTE_STANDARD_SYMBOLIC_ICON :: T.Text _FILE_ATTRIBUTE_STANDARD_SYMBOLIC_ICON = "standard::symbolic-icon" -- constant _FILE_ATTRIBUTE_STANDARD_SYMLINK_TARGET _FILE_ATTRIBUTE_STANDARD_SYMLINK_TARGET :: T.Text _FILE_ATTRIBUTE_STANDARD_SYMLINK_TARGET = "standard::symlink-target" -- constant _FILE_ATTRIBUTE_STANDARD_TARGET_URI _FILE_ATTRIBUTE_STANDARD_TARGET_URI :: T.Text _FILE_ATTRIBUTE_STANDARD_TARGET_URI = "standard::target-uri" -- constant _FILE_ATTRIBUTE_STANDARD_TYPE _FILE_ATTRIBUTE_STANDARD_TYPE :: T.Text _FILE_ATTRIBUTE_STANDARD_TYPE = "standard::type" -- constant _FILE_ATTRIBUTE_THUMBNAILING_FAILED _FILE_ATTRIBUTE_THUMBNAILING_FAILED :: T.Text _FILE_ATTRIBUTE_THUMBNAILING_FAILED = "thumbnail::failed" -- constant _FILE_ATTRIBUTE_THUMBNAIL_IS_VALID _FILE_ATTRIBUTE_THUMBNAIL_IS_VALID :: T.Text _FILE_ATTRIBUTE_THUMBNAIL_IS_VALID = "thumbnail::is-valid" -- constant _FILE_ATTRIBUTE_THUMBNAIL_PATH _FILE_ATTRIBUTE_THUMBNAIL_PATH :: T.Text _FILE_ATTRIBUTE_THUMBNAIL_PATH = "thumbnail::path" -- constant _FILE_ATTRIBUTE_TIME_ACCESS _FILE_ATTRIBUTE_TIME_ACCESS :: T.Text _FILE_ATTRIBUTE_TIME_ACCESS = "time::access" -- constant _FILE_ATTRIBUTE_TIME_ACCESS_USEC _FILE_ATTRIBUTE_TIME_ACCESS_USEC :: T.Text _FILE_ATTRIBUTE_TIME_ACCESS_USEC = "time::access-usec" -- constant _FILE_ATTRIBUTE_TIME_CHANGED _FILE_ATTRIBUTE_TIME_CHANGED :: T.Text _FILE_ATTRIBUTE_TIME_CHANGED = "time::changed" -- constant _FILE_ATTRIBUTE_TIME_CHANGED_USEC _FILE_ATTRIBUTE_TIME_CHANGED_USEC :: T.Text _FILE_ATTRIBUTE_TIME_CHANGED_USEC = "time::changed-usec" -- constant _FILE_ATTRIBUTE_TIME_CREATED _FILE_ATTRIBUTE_TIME_CREATED :: T.Text _FILE_ATTRIBUTE_TIME_CREATED = "time::created" -- constant _FILE_ATTRIBUTE_TIME_CREATED_USEC _FILE_ATTRIBUTE_TIME_CREATED_USEC :: T.Text _FILE_ATTRIBUTE_TIME_CREATED_USEC = "time::created-usec" -- constant _FILE_ATTRIBUTE_TIME_MODIFIED _FILE_ATTRIBUTE_TIME_MODIFIED :: T.Text _FILE_ATTRIBUTE_TIME_MODIFIED = "time::modified" -- constant _FILE_ATTRIBUTE_TIME_MODIFIED_USEC _FILE_ATTRIBUTE_TIME_MODIFIED_USEC :: T.Text _FILE_ATTRIBUTE_TIME_MODIFIED_USEC = "time::modified-usec" -- constant _FILE_ATTRIBUTE_TRASH_DELETION_DATE _FILE_ATTRIBUTE_TRASH_DELETION_DATE :: T.Text _FILE_ATTRIBUTE_TRASH_DELETION_DATE = "trash::deletion-date" -- constant _FILE_ATTRIBUTE_TRASH_ITEM_COUNT _FILE_ATTRIBUTE_TRASH_ITEM_COUNT :: T.Text _FILE_ATTRIBUTE_TRASH_ITEM_COUNT = "trash::item-count" -- constant _FILE_ATTRIBUTE_TRASH_ORIG_PATH _FILE_ATTRIBUTE_TRASH_ORIG_PATH :: T.Text _FILE_ATTRIBUTE_TRASH_ORIG_PATH = "trash::orig-path" -- constant _FILE_ATTRIBUTE_UNIX_BLOCKS _FILE_ATTRIBUTE_UNIX_BLOCKS :: T.Text _FILE_ATTRIBUTE_UNIX_BLOCKS = "unix::blocks" -- constant _FILE_ATTRIBUTE_UNIX_BLOCK_SIZE _FILE_ATTRIBUTE_UNIX_BLOCK_SIZE :: T.Text _FILE_ATTRIBUTE_UNIX_BLOCK_SIZE = "unix::block-size" -- constant _FILE_ATTRIBUTE_UNIX_DEVICE _FILE_ATTRIBUTE_UNIX_DEVICE :: T.Text _FILE_ATTRIBUTE_UNIX_DEVICE = "unix::device" -- constant _FILE_ATTRIBUTE_UNIX_GID _FILE_ATTRIBUTE_UNIX_GID :: T.Text _FILE_ATTRIBUTE_UNIX_GID = "unix::gid" -- constant _FILE_ATTRIBUTE_UNIX_INODE _FILE_ATTRIBUTE_UNIX_INODE :: T.Text _FILE_ATTRIBUTE_UNIX_INODE = "unix::inode" -- constant _FILE_ATTRIBUTE_UNIX_IS_MOUNTPOINT _FILE_ATTRIBUTE_UNIX_IS_MOUNTPOINT :: T.Text _FILE_ATTRIBUTE_UNIX_IS_MOUNTPOINT = "unix::is-mountpoint" -- constant _FILE_ATTRIBUTE_UNIX_MODE _FILE_ATTRIBUTE_UNIX_MODE :: T.Text _FILE_ATTRIBUTE_UNIX_MODE = "unix::mode" -- constant _FILE_ATTRIBUTE_UNIX_NLINK _FILE_ATTRIBUTE_UNIX_NLINK :: T.Text _FILE_ATTRIBUTE_UNIX_NLINK = "unix::nlink" -- constant _FILE_ATTRIBUTE_UNIX_RDEV _FILE_ATTRIBUTE_UNIX_RDEV :: T.Text _FILE_ATTRIBUTE_UNIX_RDEV = "unix::rdev" -- constant _FILE_ATTRIBUTE_UNIX_UID _FILE_ATTRIBUTE_UNIX_UID :: T.Text _FILE_ATTRIBUTE_UNIX_UID = "unix::uid" -- constant _MENU_ATTRIBUTE_ACTION _MENU_ATTRIBUTE_ACTION :: T.Text _MENU_ATTRIBUTE_ACTION = "action" -- constant _MENU_ATTRIBUTE_ACTION_NAMESPACE _MENU_ATTRIBUTE_ACTION_NAMESPACE :: T.Text _MENU_ATTRIBUTE_ACTION_NAMESPACE = "action-namespace" -- constant _MENU_ATTRIBUTE_ICON _MENU_ATTRIBUTE_ICON :: T.Text _MENU_ATTRIBUTE_ICON = "icon" -- constant _MENU_ATTRIBUTE_LABEL _MENU_ATTRIBUTE_LABEL :: T.Text _MENU_ATTRIBUTE_LABEL = "label" -- constant _MENU_ATTRIBUTE_TARGET _MENU_ATTRIBUTE_TARGET :: T.Text _MENU_ATTRIBUTE_TARGET = "target" -- constant _MENU_LINK_SECTION _MENU_LINK_SECTION :: T.Text _MENU_LINK_SECTION = "section" -- constant _MENU_LINK_SUBMENU _MENU_LINK_SUBMENU :: T.Text _MENU_LINK_SUBMENU = "submenu" -- constant _NATIVE_VOLUME_MONITOR_EXTENSION_POINT_NAME _NATIVE_VOLUME_MONITOR_EXTENSION_POINT_NAME :: T.Text _NATIVE_VOLUME_MONITOR_EXTENSION_POINT_NAME = "gio-native-volume-monitor" -- constant _NETWORK_MONITOR_EXTENSION_POINT_NAME _NETWORK_MONITOR_EXTENSION_POINT_NAME :: T.Text _NETWORK_MONITOR_EXTENSION_POINT_NAME = "gio-network-monitor" -- constant _PROXY_EXTENSION_POINT_NAME _PROXY_EXTENSION_POINT_NAME :: T.Text _PROXY_EXTENSION_POINT_NAME = "gio-proxy" -- constant _PROXY_RESOLVER_EXTENSION_POINT_NAME _PROXY_RESOLVER_EXTENSION_POINT_NAME :: T.Text _PROXY_RESOLVER_EXTENSION_POINT_NAME = "gio-proxy-resolver" -- constant _TLS_BACKEND_EXTENSION_POINT_NAME _TLS_BACKEND_EXTENSION_POINT_NAME :: T.Text _TLS_BACKEND_EXTENSION_POINT_NAME = "gio-tls-backend" -- constant _TLS_DATABASE_PURPOSE_AUTHENTICATE_CLIENT _TLS_DATABASE_PURPOSE_AUTHENTICATE_CLIENT :: T.Text _TLS_DATABASE_PURPOSE_AUTHENTICATE_CLIENT = "1.3.6.1.5.5.7.3.2" -- constant _TLS_DATABASE_PURPOSE_AUTHENTICATE_SERVER _TLS_DATABASE_PURPOSE_AUTHENTICATE_SERVER :: T.Text _TLS_DATABASE_PURPOSE_AUTHENTICATE_SERVER = "1.3.6.1.5.5.7.3.1" -- constant _VFS_EXTENSION_POINT_NAME _VFS_EXTENSION_POINT_NAME :: T.Text _VFS_EXTENSION_POINT_NAME = "gio-vfs" -- constant _VOLUME_IDENTIFIER_KIND_CLASS _VOLUME_IDENTIFIER_KIND_CLASS :: T.Text _VOLUME_IDENTIFIER_KIND_CLASS = "class" -- constant _VOLUME_IDENTIFIER_KIND_HAL_UDI _VOLUME_IDENTIFIER_KIND_HAL_UDI :: T.Text _VOLUME_IDENTIFIER_KIND_HAL_UDI = "hal-udi" -- constant _VOLUME_IDENTIFIER_KIND_LABEL _VOLUME_IDENTIFIER_KIND_LABEL :: T.Text _VOLUME_IDENTIFIER_KIND_LABEL = "label" -- constant _VOLUME_IDENTIFIER_KIND_NFS_MOUNT _VOLUME_IDENTIFIER_KIND_NFS_MOUNT :: T.Text _VOLUME_IDENTIFIER_KIND_NFS_MOUNT = "nfs-mount" -- constant _VOLUME_IDENTIFIER_KIND_UNIX_DEVICE _VOLUME_IDENTIFIER_KIND_UNIX_DEVICE :: T.Text _VOLUME_IDENTIFIER_KIND_UNIX_DEVICE = "unix-device" -- constant _VOLUME_IDENTIFIER_KIND_UUID _VOLUME_IDENTIFIER_KIND_UUID :: T.Text _VOLUME_IDENTIFIER_KIND_UUID = "uuid" -- constant _VOLUME_MONITOR_EXTENSION_POINT_NAME _VOLUME_MONITOR_EXTENSION_POINT_NAME :: T.Text _VOLUME_MONITOR_EXTENSION_POINT_NAME = "gio-volume-monitor" -- function g_action_name_is_valid -- Args : [Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "action_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_action_name_is_valid" g_action_name_is_valid :: CString -> -- action_name : TBasicType TUTF8 IO CInt actionNameIsValid :: (MonadIO m) => T.Text -> -- action_name m Bool actionNameIsValid action_name = liftIO $ do action_name' <- textToCString action_name result <- g_action_name_is_valid action_name' let result' = (/= 0) result freeMem action_name' return result' -- function g_action_parse_detailed_name -- Args : [Arg {argName = "detailed_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "target_value", argType = TVariant, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "detailed_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_action_parse_detailed_name" g_action_parse_detailed_name :: CString -> -- detailed_name : TBasicType TUTF8 Ptr CString -> -- action_name : TBasicType TUTF8 Ptr (Ptr GVariant) -> -- target_value : TVariant Ptr (Ptr GError) -> -- error IO CInt actionParseDetailedName :: (MonadIO m) => T.Text -> -- detailed_name m (T.Text,GVariant) actionParseDetailedName detailed_name = liftIO $ do detailed_name' <- textToCString detailed_name action_name <- allocMem :: IO (Ptr CString) target_value <- allocMem :: IO (Ptr (Ptr GVariant)) onException (do _ <- propagateGError $ g_action_parse_detailed_name detailed_name' action_name target_value action_name' <- peek action_name action_name'' <- cstringToText action_name' freeMem action_name' target_value' <- peek target_value target_value'' <- wrapGVariantPtr target_value' freeMem detailed_name' freeMem action_name freeMem target_value return (action_name'', target_value'') ) (do freeMem detailed_name' freeMem action_name freeMem target_value ) -- function g_action_print_detailed_name -- Args : [Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "action_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_action_print_detailed_name" g_action_print_detailed_name :: CString -> -- action_name : TBasicType TUTF8 Ptr GVariant -> -- target_value : TVariant IO CString actionPrintDetailedName :: (MonadIO m) => T.Text -> -- action_name Maybe (GVariant) -> -- target_value m T.Text actionPrintDetailedName action_name target_value = liftIO $ do action_name' <- textToCString action_name maybeTarget_value <- case target_value of Nothing -> return nullPtr Just jTarget_value -> do let jTarget_value' = unsafeManagedPtrGetPtr jTarget_value return jTarget_value' result <- g_action_print_detailed_name action_name' maybeTarget_value checkUnexpectedReturnNULL "g_action_print_detailed_name" result result' <- cstringToText result freeMem result freeMem action_name' return result' -- function g_app_info_create_from_commandline -- Args : [Arg {argName = "commandline", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "application_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "AppInfoCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "commandline", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "application_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "AppInfoCreateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "AppInfo" -- throws : True -- Skip return : False foreign import ccall "g_app_info_create_from_commandline" g_app_info_create_from_commandline :: CString -> -- commandline : TBasicType TUTF8 CString -> -- application_name : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "AppInfoCreateFlags" Ptr (Ptr GError) -> -- error IO (Ptr AppInfo) appInfoCreateFromCommandline :: (MonadIO m) => T.Text -> -- commandline Maybe (T.Text) -> -- application_name [AppInfoCreateFlags] -> -- flags m AppInfo appInfoCreateFromCommandline commandline application_name flags = liftIO $ do commandline' <- textToCString commandline maybeApplication_name <- case application_name of Nothing -> return nullPtr Just jApplication_name -> do jApplication_name' <- textToCString jApplication_name return jApplication_name' let flags' = gflagsToWord flags onException (do result <- propagateGError $ g_app_info_create_from_commandline commandline' maybeApplication_name flags' checkUnexpectedReturnNULL "g_app_info_create_from_commandline" result result' <- (wrapObject AppInfo) result freeMem commandline' freeMem maybeApplication_name return result' ) (do freeMem commandline' freeMem maybeApplication_name ) -- function g_app_info_get_all -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TGList (TInterface "Gio" "AppInfo") -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_all" g_app_info_get_all :: IO (Ptr (GList (Ptr AppInfo))) appInfoGetAll :: (MonadIO m) => m [AppInfo] appInfoGetAll = liftIO $ do result <- g_app_info_get_all checkUnexpectedReturnNULL "g_app_info_get_all" result result' <- unpackGList result result'' <- mapM (wrapObject AppInfo) result' g_list_free result return result'' -- function g_app_info_get_all_for_type -- Args : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "AppInfo") -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_all_for_type" g_app_info_get_all_for_type :: CString -> -- content_type : TBasicType TUTF8 IO (Ptr (GList (Ptr AppInfo))) appInfoGetAllForType :: (MonadIO m) => T.Text -> -- content_type m [AppInfo] appInfoGetAllForType content_type = liftIO $ do content_type' <- textToCString content_type result <- g_app_info_get_all_for_type content_type' checkUnexpectedReturnNULL "g_app_info_get_all_for_type" result result' <- unpackGList result result'' <- mapM (wrapObject AppInfo) result' g_list_free result freeMem content_type' return result'' -- function g_app_info_get_default_for_type -- Args : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "must_support_uris", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "must_support_uris", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "AppInfo" -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_default_for_type" g_app_info_get_default_for_type :: CString -> -- content_type : TBasicType TUTF8 CInt -> -- must_support_uris : TBasicType TBoolean IO (Ptr AppInfo) appInfoGetDefaultForType :: (MonadIO m) => T.Text -> -- content_type Bool -> -- must_support_uris m AppInfo appInfoGetDefaultForType content_type must_support_uris = liftIO $ do content_type' <- textToCString content_type let must_support_uris' = (fromIntegral . fromEnum) must_support_uris result <- g_app_info_get_default_for_type content_type' must_support_uris' checkUnexpectedReturnNULL "g_app_info_get_default_for_type" result result' <- (wrapObject AppInfo) result freeMem content_type' return result' -- function g_app_info_get_default_for_uri_scheme -- Args : [Arg {argName = "uri_scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "uri_scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "AppInfo" -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_default_for_uri_scheme" g_app_info_get_default_for_uri_scheme :: CString -> -- uri_scheme : TBasicType TUTF8 IO (Ptr AppInfo) appInfoGetDefaultForUriScheme :: (MonadIO m) => T.Text -> -- uri_scheme m AppInfo appInfoGetDefaultForUriScheme uri_scheme = liftIO $ do uri_scheme' <- textToCString uri_scheme result <- g_app_info_get_default_for_uri_scheme uri_scheme' checkUnexpectedReturnNULL "g_app_info_get_default_for_uri_scheme" result result' <- (wrapObject AppInfo) result freeMem uri_scheme' return result' -- function g_app_info_get_fallback_for_type -- Args : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "AppInfo") -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_fallback_for_type" g_app_info_get_fallback_for_type :: CString -> -- content_type : TBasicType TUTF8 IO (Ptr (GList (Ptr AppInfo))) appInfoGetFallbackForType :: (MonadIO m) => T.Text -> -- content_type m [AppInfo] appInfoGetFallbackForType content_type = liftIO $ do content_type' <- textToCString content_type result <- g_app_info_get_fallback_for_type content_type' checkUnexpectedReturnNULL "g_app_info_get_fallback_for_type" result result' <- unpackGList result result'' <- mapM (wrapObject AppInfo) result' g_list_free result freeMem content_type' return result'' -- function g_app_info_get_recommended_for_type -- Args : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Gio" "AppInfo") -- throws : False -- Skip return : False foreign import ccall "g_app_info_get_recommended_for_type" g_app_info_get_recommended_for_type :: CString -> -- content_type : TBasicType TUTF8 IO (Ptr (GList (Ptr AppInfo))) appInfoGetRecommendedForType :: (MonadIO m) => T.Text -> -- content_type m [AppInfo] appInfoGetRecommendedForType content_type = liftIO $ do content_type' <- textToCString content_type result <- g_app_info_get_recommended_for_type content_type' checkUnexpectedReturnNULL "g_app_info_get_recommended_for_type" result result' <- unpackGList result result'' <- mapM (wrapObject AppInfo) result' g_list_free result freeMem content_type' return result'' -- function g_app_info_launch_default_for_uri -- Args : [Arg {argName = "uri", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "launch_context", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = True, 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},Arg {argName = "launch_context", argType = TInterface "Gio" "AppLaunchContext", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_app_info_launch_default_for_uri" g_app_info_launch_default_for_uri :: CString -> -- uri : TBasicType TUTF8 Ptr AppLaunchContext -> -- launch_context : TInterface "Gio" "AppLaunchContext" Ptr (Ptr GError) -> -- error IO CInt appInfoLaunchDefaultForUri :: (MonadIO m, AppLaunchContextK a) => T.Text -> -- uri Maybe (a) -> -- launch_context m () appInfoLaunchDefaultForUri uri launch_context = liftIO $ do uri' <- textToCString uri maybeLaunch_context <- case launch_context of Nothing -> return nullPtr Just jLaunch_context -> do let jLaunch_context' = unsafeManagedPtrCastPtr jLaunch_context return jLaunch_context' onException (do _ <- propagateGError $ g_app_info_launch_default_for_uri uri' maybeLaunch_context whenJust launch_context touchManagedPtr freeMem uri' return () ) (do freeMem uri' ) -- function g_app_info_reset_type_associations -- Args : [Arg {argName = "content_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "content_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_app_info_reset_type_associations" g_app_info_reset_type_associations :: CString -> -- content_type : TBasicType TUTF8 IO () appInfoResetTypeAssociations :: (MonadIO m) => T.Text -> -- content_type m () appInfoResetTypeAssociations content_type = liftIO $ do content_type' <- textToCString content_type g_app_info_reset_type_associations content_type' freeMem content_type' return () -- function g_async_initable_newv_async -- Args : [Arg {argName = "object_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_parameters", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TInterface "GObject" "Parameter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, 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 = "object_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_parameters", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TInterface "GObject" "Parameter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 6, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_async_initable_newv_async" g_async_initable_newv_async :: CGType -> -- object_type : TBasicType TGType Word32 -> -- n_parameters : TBasicType TUInt32 Ptr GObject.Parameter -> -- parameters : TInterface "GObject" "Parameter" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () asyncInitableNewvAsync :: (MonadIO m, CancellableK a) => GType -> -- object_type Word32 -> -- n_parameters GObject.Parameter -> -- parameters Int32 -> -- io_priority Maybe (a) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () asyncInitableNewvAsync object_type n_parameters parameters io_priority cancellable callback = liftIO $ do let object_type' = gtypeToCGType object_type let parameters' = unsafeManagedPtrGetPtr parameters maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_async_initable_newv_async object_type' n_parameters parameters' io_priority maybeCancellable maybeCallback user_data touchManagedPtr parameters whenJust cancellable touchManagedPtr return () -- function g_bus_get -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_bus_get" g_bus_get :: CUInt -> -- bus_type : TInterface "Gio" "BusType" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () busGet :: (MonadIO m, CancellableK a) => BusType -> -- bus_type Maybe (a) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () busGet bus_type cancellable callback = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_bus_get bus_type' maybeCancellable maybeCallback user_data whenJust cancellable touchManagedPtr return () -- function g_bus_get_finish -- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : True -- Skip return : False foreign import ccall "g_bus_get_finish" g_bus_get_finish :: Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" Ptr (Ptr GError) -> -- error IO (Ptr DBusConnection) busGetFinish :: (MonadIO m, AsyncResultK a) => a -> -- res m DBusConnection busGetFinish res = liftIO $ do let res' = unsafeManagedPtrCastPtr res onException (do result <- propagateGError $ g_bus_get_finish res' checkUnexpectedReturnNULL "g_bus_get_finish" result result' <- (wrapObject DBusConnection) result touchManagedPtr res return result' ) (do return () ) -- function g_bus_get_sync -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "DBusConnection" -- throws : True -- Skip return : False foreign import ccall "g_bus_get_sync" g_bus_get_sync :: CUInt -> -- bus_type : TInterface "Gio" "BusType" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr DBusConnection) busGetSync :: (MonadIO m, CancellableK a) => BusType -> -- bus_type Maybe (a) -> -- cancellable m DBusConnection busGetSync bus_type cancellable = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_bus_get_sync bus_type' maybeCancellable checkUnexpectedReturnNULL "g_bus_get_sync" result result' <- (wrapObject DBusConnection) result whenJust cancellable touchManagedPtr return result' ) (do return () ) -- function g_bus_own_name_with_closures -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", 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 = "flags", argType = TInterface "Gio" "BusNameOwnerFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_acquired_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_acquired_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_lost_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", 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 = "flags", argType = TInterface "Gio" "BusNameOwnerFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bus_acquired_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_acquired_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_lost_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_bus_own_name_with_closures" g_bus_own_name_with_closures :: CUInt -> -- bus_type : TInterface "Gio" "BusType" CString -> -- name : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "BusNameOwnerFlags" Ptr Closure -> -- bus_acquired_closure : TInterface "GObject" "Closure" Ptr Closure -> -- name_acquired_closure : TInterface "GObject" "Closure" Ptr Closure -> -- name_lost_closure : TInterface "GObject" "Closure" IO Word32 busOwnName :: (MonadIO m) => BusType -> -- bus_type T.Text -> -- name [BusNameOwnerFlags] -> -- flags Maybe (Closure) -> -- bus_acquired_closure Maybe (Closure) -> -- name_acquired_closure Maybe (Closure) -> -- name_lost_closure m Word32 busOwnName bus_type name flags bus_acquired_closure name_acquired_closure name_lost_closure = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type name' <- textToCString name let flags' = gflagsToWord flags maybeBus_acquired_closure <- case bus_acquired_closure of Nothing -> return nullPtr Just jBus_acquired_closure -> do let jBus_acquired_closure' = unsafeManagedPtrGetPtr jBus_acquired_closure return jBus_acquired_closure' maybeName_acquired_closure <- case name_acquired_closure of Nothing -> return nullPtr Just jName_acquired_closure -> do let jName_acquired_closure' = unsafeManagedPtrGetPtr jName_acquired_closure return jName_acquired_closure' maybeName_lost_closure <- case name_lost_closure of Nothing -> return nullPtr Just jName_lost_closure -> do let jName_lost_closure' = unsafeManagedPtrGetPtr jName_lost_closure return jName_lost_closure' result <- g_bus_own_name_with_closures bus_type' name' flags' maybeBus_acquired_closure maybeName_acquired_closure maybeName_lost_closure whenJust bus_acquired_closure touchManagedPtr whenJust name_acquired_closure touchManagedPtr whenJust name_lost_closure touchManagedPtr freeMem name' return result -- function g_bus_own_name_on_connection_with_closures -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", 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 = "flags", argType = TInterface "Gio" "BusNameOwnerFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_acquired_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_lost_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", 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 = "flags", argType = TInterface "Gio" "BusNameOwnerFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_acquired_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_lost_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_bus_own_name_on_connection_with_closures" g_bus_own_name_on_connection_with_closures :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CString -> -- name : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "BusNameOwnerFlags" Ptr Closure -> -- name_acquired_closure : TInterface "GObject" "Closure" Ptr Closure -> -- name_lost_closure : TInterface "GObject" "Closure" IO Word32 busOwnNameOnConnection :: (MonadIO m, DBusConnectionK a) => a -> -- connection T.Text -> -- name [BusNameOwnerFlags] -> -- flags Maybe (Closure) -> -- name_acquired_closure Maybe (Closure) -> -- name_lost_closure m Word32 busOwnNameOnConnection connection name flags name_acquired_closure name_lost_closure = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection name' <- textToCString name let flags' = gflagsToWord flags maybeName_acquired_closure <- case name_acquired_closure of Nothing -> return nullPtr Just jName_acquired_closure -> do let jName_acquired_closure' = unsafeManagedPtrGetPtr jName_acquired_closure return jName_acquired_closure' maybeName_lost_closure <- case name_lost_closure of Nothing -> return nullPtr Just jName_lost_closure -> do let jName_lost_closure' = unsafeManagedPtrGetPtr jName_lost_closure return jName_lost_closure' result <- g_bus_own_name_on_connection_with_closures connection' name' flags' maybeName_acquired_closure maybeName_lost_closure touchManagedPtr connection whenJust name_acquired_closure touchManagedPtr whenJust name_lost_closure touchManagedPtr freeMem name' return result -- function g_bus_unown_name -- Args : [Arg {argName = "owner_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "owner_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_bus_unown_name" g_bus_unown_name :: Word32 -> -- owner_id : TBasicType TUInt32 IO () busUnownName :: (MonadIO m) => Word32 -> -- owner_id m () busUnownName owner_id = liftIO $ do g_bus_unown_name owner_id return () -- function g_bus_unwatch_name -- Args : [Arg {argName = "watcher_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "watcher_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_bus_unwatch_name" g_bus_unwatch_name :: Word32 -> -- watcher_id : TBasicType TUInt32 IO () busUnwatchName :: (MonadIO m) => Word32 -> -- watcher_id m () busUnwatchName watcher_id = liftIO $ do g_bus_unwatch_name watcher_id return () -- function g_bus_watch_name_with_closures -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", 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 = "flags", argType = TInterface "Gio" "BusNameWatcherFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_appeared_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_vanished_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", 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 = "flags", argType = TInterface "Gio" "BusNameWatcherFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_appeared_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_vanished_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_bus_watch_name_with_closures" g_bus_watch_name_with_closures :: CUInt -> -- bus_type : TInterface "Gio" "BusType" CString -> -- name : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "BusNameWatcherFlags" Ptr Closure -> -- name_appeared_closure : TInterface "GObject" "Closure" Ptr Closure -> -- name_vanished_closure : TInterface "GObject" "Closure" IO Word32 busWatchName :: (MonadIO m) => BusType -> -- bus_type T.Text -> -- name [BusNameWatcherFlags] -> -- flags Maybe (Closure) -> -- name_appeared_closure Maybe (Closure) -> -- name_vanished_closure m Word32 busWatchName bus_type name flags name_appeared_closure name_vanished_closure = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type name' <- textToCString name let flags' = gflagsToWord flags maybeName_appeared_closure <- case name_appeared_closure of Nothing -> return nullPtr Just jName_appeared_closure -> do let jName_appeared_closure' = unsafeManagedPtrGetPtr jName_appeared_closure return jName_appeared_closure' maybeName_vanished_closure <- case name_vanished_closure of Nothing -> return nullPtr Just jName_vanished_closure -> do let jName_vanished_closure' = unsafeManagedPtrGetPtr jName_vanished_closure return jName_vanished_closure' result <- g_bus_watch_name_with_closures bus_type' name' flags' maybeName_appeared_closure maybeName_vanished_closure whenJust name_appeared_closure touchManagedPtr whenJust name_vanished_closure touchManagedPtr freeMem name' return result -- function g_bus_watch_name_on_connection_with_closures -- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", 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 = "flags", argType = TInterface "Gio" "BusNameWatcherFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_appeared_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_vanished_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", 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 = "flags", argType = TInterface "Gio" "BusNameWatcherFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_appeared_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name_vanished_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_bus_watch_name_on_connection_with_closures" g_bus_watch_name_on_connection_with_closures :: Ptr DBusConnection -> -- connection : TInterface "Gio" "DBusConnection" CString -> -- name : TBasicType TUTF8 CUInt -> -- flags : TInterface "Gio" "BusNameWatcherFlags" Ptr Closure -> -- name_appeared_closure : TInterface "GObject" "Closure" Ptr Closure -> -- name_vanished_closure : TInterface "GObject" "Closure" IO Word32 busWatchNameOnConnection :: (MonadIO m, DBusConnectionK a) => a -> -- connection T.Text -> -- name [BusNameWatcherFlags] -> -- flags Maybe (Closure) -> -- name_appeared_closure Maybe (Closure) -> -- name_vanished_closure m Word32 busWatchNameOnConnection connection name flags name_appeared_closure name_vanished_closure = liftIO $ do let connection' = unsafeManagedPtrCastPtr connection name' <- textToCString name let flags' = gflagsToWord flags maybeName_appeared_closure <- case name_appeared_closure of Nothing -> return nullPtr Just jName_appeared_closure -> do let jName_appeared_closure' = unsafeManagedPtrGetPtr jName_appeared_closure return jName_appeared_closure' maybeName_vanished_closure <- case name_vanished_closure of Nothing -> return nullPtr Just jName_vanished_closure -> do let jName_vanished_closure' = unsafeManagedPtrGetPtr jName_vanished_closure return jName_vanished_closure' result <- g_bus_watch_name_on_connection_with_closures connection' name' flags' maybeName_appeared_closure maybeName_vanished_closure touchManagedPtr connection whenJust name_appeared_closure touchManagedPtr whenJust name_vanished_closure touchManagedPtr freeMem name' return result -- function g_content_type_can_be_executable -- Args : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", 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_content_type_can_be_executable" g_content_type_can_be_executable :: CString -> -- type : TBasicType TUTF8 IO CInt contentTypeCanBeExecutable :: (MonadIO m) => T.Text -> -- type m Bool contentTypeCanBeExecutable type_ = liftIO $ do type_' <- textToCString type_ result <- g_content_type_can_be_executable type_' let result' = (/= 0) result freeMem type_' return result' -- function g_content_type_equals -- Args : [Arg {argName = "type1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type2", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type1", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type2", 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_content_type_equals" g_content_type_equals :: CString -> -- type1 : TBasicType TUTF8 CString -> -- type2 : TBasicType TUTF8 IO CInt contentTypeEquals :: (MonadIO m) => T.Text -> -- type1 T.Text -> -- type2 m Bool contentTypeEquals type1 type2 = liftIO $ do type1' <- textToCString type1 type2' <- textToCString type2 result <- g_content_type_equals type1' type2' let result' = (/= 0) result freeMem type1' freeMem type2' return result' -- function g_content_type_from_mime_type -- Args : [Arg {argName = "mime_type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mime_type", 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_content_type_from_mime_type" g_content_type_from_mime_type :: CString -> -- mime_type : TBasicType TUTF8 IO CString contentTypeFromMimeType :: (MonadIO m) => T.Text -> -- mime_type m T.Text contentTypeFromMimeType mime_type = liftIO $ do mime_type' <- textToCString mime_type result <- g_content_type_from_mime_type mime_type' checkUnexpectedReturnNULL "g_content_type_from_mime_type" result result' <- cstringToText result freeMem result freeMem mime_type' return result' -- function g_content_type_get_description -- Args : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", 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_content_type_get_description" g_content_type_get_description :: CString -> -- type : TBasicType TUTF8 IO CString contentTypeGetDescription :: (MonadIO m) => T.Text -> -- type m T.Text contentTypeGetDescription type_ = liftIO $ do type_' <- textToCString type_ result <- g_content_type_get_description type_' checkUnexpectedReturnNULL "g_content_type_get_description" result result' <- cstringToText result freeMem result freeMem type_' return result' -- function g_content_type_get_generic_icon_name -- Args : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", 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_content_type_get_generic_icon_name" g_content_type_get_generic_icon_name :: CString -> -- type : TBasicType TUTF8 IO CString contentTypeGetGenericIconName :: (MonadIO m) => T.Text -> -- type m T.Text contentTypeGetGenericIconName type_ = liftIO $ do type_' <- textToCString type_ result <- g_content_type_get_generic_icon_name type_' checkUnexpectedReturnNULL "g_content_type_get_generic_icon_name" result result' <- cstringToText result freeMem result freeMem type_' return result' -- function g_content_type_get_icon -- Args : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_content_type_get_icon" g_content_type_get_icon :: CString -> -- type : TBasicType TUTF8 IO (Ptr Icon) contentTypeGetIcon :: (MonadIO m) => T.Text -> -- type m Icon contentTypeGetIcon type_ = liftIO $ do type_' <- textToCString type_ result <- g_content_type_get_icon type_' checkUnexpectedReturnNULL "g_content_type_get_icon" result result' <- (wrapObject Icon) result freeMem type_' return result' -- function g_content_type_get_mime_type -- Args : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", 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_content_type_get_mime_type" g_content_type_get_mime_type :: CString -> -- type : TBasicType TUTF8 IO CString contentTypeGetMimeType :: (MonadIO m) => T.Text -> -- type m T.Text contentTypeGetMimeType type_ = liftIO $ do type_' <- textToCString type_ result <- g_content_type_get_mime_type type_' checkUnexpectedReturnNULL "g_content_type_get_mime_type" result result' <- cstringToText result freeMem result freeMem type_' return result' -- function g_content_type_get_symbolic_icon -- Args : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_content_type_get_symbolic_icon" g_content_type_get_symbolic_icon :: CString -> -- type : TBasicType TUTF8 IO (Ptr Icon) contentTypeGetSymbolicIcon :: (MonadIO m) => T.Text -> -- type m Icon contentTypeGetSymbolicIcon type_ = liftIO $ do type_' <- textToCString type_ result <- g_content_type_get_symbolic_icon type_' checkUnexpectedReturnNULL "g_content_type_get_symbolic_icon" result result' <- (wrapObject Icon) result freeMem type_' return result' -- function g_content_type_guess -- Args : [Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result_uncertain", argType = TBasicType TBoolean, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "data_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "filename", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_content_type_guess" g_content_type_guess :: CString -> -- filename : TBasicType TUTF8 Ptr Word8 -> -- data : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- data_size : TBasicType TUInt64 Ptr CInt -> -- result_uncertain : TBasicType TBoolean IO CString contentTypeGuess :: (MonadIO m) => Maybe (T.Text) -> -- filename Maybe (ByteString) -> -- data m (T.Text,Bool) contentTypeGuess filename data_ = liftIO $ do let data_size = case data_ of Nothing -> 0 Just jData_ -> fromIntegral $ B.length jData_ maybeFilename <- case filename of Nothing -> return nullPtr Just jFilename -> do jFilename' <- textToCString jFilename return jFilename' maybeData_ <- case data_ of Nothing -> return nullPtr Just jData_ -> do jData_' <- packByteString jData_ return jData_' result_uncertain <- allocMem :: IO (Ptr CInt) result <- g_content_type_guess maybeFilename maybeData_ data_size result_uncertain checkUnexpectedReturnNULL "g_content_type_guess" result result' <- cstringToText result freeMem result result_uncertain' <- peek result_uncertain let result_uncertain'' = (/= 0) result_uncertain' freeMem maybeFilename freeMem maybeData_ freeMem result_uncertain return (result', result_uncertain'') -- function g_content_type_guess_for_tree -- Args : [Arg {argName = "root", argType = TInterface "Gio" "File", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "root", argType = TInterface "Gio" "File", 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_content_type_guess_for_tree" g_content_type_guess_for_tree :: Ptr File -> -- root : TInterface "Gio" "File" IO (Ptr CString) contentTypeGuessForTree :: (MonadIO m, FileK a) => a -> -- root m [T.Text] contentTypeGuessForTree root = liftIO $ do let root' = unsafeManagedPtrCastPtr root result <- g_content_type_guess_for_tree root' checkUnexpectedReturnNULL "g_content_type_guess_for_tree" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result touchManagedPtr root return result' -- function g_content_type_is_a -- Args : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "supertype", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "supertype", 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_content_type_is_a" g_content_type_is_a :: CString -> -- type : TBasicType TUTF8 CString -> -- supertype : TBasicType TUTF8 IO CInt contentTypeIsA :: (MonadIO m) => T.Text -> -- type T.Text -> -- supertype m Bool contentTypeIsA type_ supertype = liftIO $ do type_' <- textToCString type_ supertype' <- textToCString supertype result <- g_content_type_is_a type_' supertype' let result' = (/= 0) result freeMem type_' freeMem supertype' return result' -- function g_content_type_is_unknown -- Args : [Arg {argName = "type", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", 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_content_type_is_unknown" g_content_type_is_unknown :: CString -> -- type : TBasicType TUTF8 IO CInt contentTypeIsUnknown :: (MonadIO m) => T.Text -> -- type m Bool contentTypeIsUnknown type_ = liftIO $ do type_' <- textToCString type_ result <- g_content_type_is_unknown type_' let result' = (/= 0) result freeMem type_' return result' -- function g_content_types_get_registered -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TGList (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "g_content_types_get_registered" g_content_types_get_registered :: IO (Ptr (GList CString)) contentTypesGetRegistered :: (MonadIO m) => m [T.Text] contentTypesGetRegistered = liftIO $ do result <- g_content_types_get_registered checkUnexpectedReturnNULL "g_content_types_get_registered" result result' <- unpackGList result result'' <- mapM cstringToText result' mapGList freeMem result g_list_free result return result'' -- function g_dbus_address_escape_value -- 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_dbus_address_escape_value" g_dbus_address_escape_value :: CString -> -- string : TBasicType TUTF8 IO CString dbusAddressEscapeValue :: (MonadIO m) => T.Text -> -- string m T.Text dbusAddressEscapeValue string = liftIO $ do string' <- textToCString string result <- g_dbus_address_escape_value string' checkUnexpectedReturnNULL "g_dbus_address_escape_value" result result' <- cstringToText result freeMem result freeMem string' return result' -- function g_dbus_address_get_for_bus_sync -- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : True -- Skip return : False foreign import ccall "g_dbus_address_get_for_bus_sync" g_dbus_address_get_for_bus_sync :: CUInt -> -- bus_type : TInterface "Gio" "BusType" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CString dbusAddressGetForBusSync :: (MonadIO m, CancellableK a) => BusType -> -- bus_type Maybe (a) -> -- cancellable m T.Text dbusAddressGetForBusSync bus_type cancellable = liftIO $ do let bus_type' = (fromIntegral . fromEnum) bus_type maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_address_get_for_bus_sync bus_type' maybeCancellable checkUnexpectedReturnNULL "g_dbus_address_get_for_bus_sync" result result' <- cstringToText result freeMem result whenJust cancellable touchManagedPtr return result' ) (do return () ) -- function g_dbus_address_get_stream -- Args : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, 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 = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_dbus_address_get_stream" g_dbus_address_get_stream :: CString -> -- address : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid IO () dbusAddressGetStream :: (MonadIO m, CancellableK a) => T.Text -> -- address Maybe (a) -> -- cancellable Maybe (AsyncReadyCallback) -> -- callback m () dbusAddressGetStream address cancellable callback = liftIO $ do address' <- textToCString address maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let user_data = nullPtr g_dbus_address_get_stream address' maybeCancellable maybeCallback user_data whenJust cancellable touchManagedPtr freeMem address' return () -- function g_dbus_address_get_stream_finish -- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "IOStream" -- throws : True -- Skip return : False foreign import ccall "g_dbus_address_get_stream_finish" g_dbus_address_get_stream_finish :: Ptr AsyncResult -> -- res : TInterface "Gio" "AsyncResult" CString -> -- out_guid : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr IOStream) dbusAddressGetStreamFinish :: (MonadIO m, AsyncResultK a) => a -> -- res T.Text -> -- out_guid m IOStream dbusAddressGetStreamFinish res out_guid = liftIO $ do let res' = unsafeManagedPtrCastPtr res out_guid' <- textToCString out_guid onException (do result <- propagateGError $ g_dbus_address_get_stream_finish res' out_guid' checkUnexpectedReturnNULL "g_dbus_address_get_stream_finish" result result' <- (wrapObject IOStream) result touchManagedPtr res freeMem out_guid' return result' ) (do freeMem out_guid' ) -- function g_dbus_address_get_stream_sync -- Args : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "address", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_guid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "IOStream" -- throws : True -- Skip return : False foreign import ccall "g_dbus_address_get_stream_sync" g_dbus_address_get_stream_sync :: CString -> -- address : TBasicType TUTF8 CString -> -- out_guid : TBasicType TUTF8 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr IOStream) dbusAddressGetStreamSync :: (MonadIO m, CancellableK a) => T.Text -> -- address T.Text -> -- out_guid Maybe (a) -> -- cancellable m IOStream dbusAddressGetStreamSync address out_guid cancellable = liftIO $ do address' <- textToCString address out_guid' <- textToCString out_guid maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_dbus_address_get_stream_sync address' out_guid' maybeCancellable checkUnexpectedReturnNULL "g_dbus_address_get_stream_sync" result result' <- (wrapObject IOStream) result whenJust cancellable touchManagedPtr freeMem address' freeMem out_guid' return result' ) (do freeMem address' freeMem out_guid' ) -- function g_dbus_annotation_info_lookup -- Args : [Arg {argName = "annotations", argType = TCArray True (-1) (-1) (TInterface "Gio" "DBusAnnotationInfo"), direction = DirectionIn, mayBeNull = True, 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 = "annotations", argType = TCArray True (-1) (-1) (TInterface "Gio" "DBusAnnotationInfo"), direction = DirectionIn, mayBeNull = True, 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_dbus_annotation_info_lookup" g_dbus_annotation_info_lookup :: Ptr (Ptr DBusAnnotationInfo) -> -- annotations : TCArray True (-1) (-1) (TInterface "Gio" "DBusAnnotationInfo") CString -> -- name : TBasicType TUTF8 IO CString dbusAnnotationInfoLookup :: (MonadIO m) => Maybe ([DBusAnnotationInfo]) -> -- annotations T.Text -> -- name m T.Text dbusAnnotationInfoLookup annotations name = liftIO $ do maybeAnnotations <- case annotations of Nothing -> return nullPtr Just jAnnotations -> do let jAnnotations' = map unsafeManagedPtrGetPtr jAnnotations jAnnotations'' <- packZeroTerminatedPtrArray jAnnotations' return jAnnotations'' name' <- textToCString name result <- g_dbus_annotation_info_lookup maybeAnnotations name' checkUnexpectedReturnNULL "g_dbus_annotation_info_lookup" result result' <- cstringToText result whenJust annotations (mapM_ touchManagedPtr) freeMem maybeAnnotations freeMem name' return result' -- function g_dbus_error_encode_gerror -- Args : [Arg {argName = "error", argType = TError, 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}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_error_encode_gerror" g_dbus_error_encode_gerror :: Ptr GError -> -- error : TError IO CString dbusErrorEncodeGerror :: (MonadIO m) => GError -> -- error m T.Text dbusErrorEncodeGerror error_ = liftIO $ do let error_' = unsafeManagedPtrGetPtr error_ result <- g_dbus_error_encode_gerror error_' checkUnexpectedReturnNULL "g_dbus_error_encode_gerror" result result' <- cstringToText result freeMem result touchManagedPtr error_ return result' -- function g_dbus_error_get_remote_error -- Args : [Arg {argName = "error", argType = TError, 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}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_error_get_remote_error" g_dbus_error_get_remote_error :: Ptr GError -> -- error : TError IO CString dbusErrorGetRemoteError :: (MonadIO m) => GError -> -- error m T.Text dbusErrorGetRemoteError error_ = liftIO $ do let error_' = unsafeManagedPtrGetPtr error_ result <- g_dbus_error_get_remote_error error_' checkUnexpectedReturnNULL "g_dbus_error_get_remote_error" result result' <- cstringToText result freeMem result touchManagedPtr error_ return result' -- function g_dbus_error_is_remote_error -- Args : [Arg {argName = "error", argType = TError, 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}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_error_is_remote_error" g_dbus_error_is_remote_error :: Ptr GError -> -- error : TError IO CInt dbusErrorIsRemoteError :: (MonadIO m) => GError -> -- error m Bool dbusErrorIsRemoteError error_ = liftIO $ do let error_' = unsafeManagedPtrGetPtr error_ result <- g_dbus_error_is_remote_error error_' let result' = (/= 0) result touchManagedPtr error_ return result' -- function g_dbus_error_new_for_dbus_error -- Args : [Arg {argName = "dbus_error_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dbus_error_message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dbus_error_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dbus_error_message", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TError -- throws : False -- Skip return : False foreign import ccall "g_dbus_error_new_for_dbus_error" g_dbus_error_new_for_dbus_error :: CString -> -- dbus_error_name : TBasicType TUTF8 CString -> -- dbus_error_message : TBasicType TUTF8 IO (Ptr GError) dbusErrorNewForDbusError :: (MonadIO m) => T.Text -> -- dbus_error_name T.Text -> -- dbus_error_message m GError dbusErrorNewForDbusError dbus_error_name dbus_error_message = liftIO $ do dbus_error_name' <- textToCString dbus_error_name dbus_error_message' <- textToCString dbus_error_message result <- g_dbus_error_new_for_dbus_error dbus_error_name' dbus_error_message' checkUnexpectedReturnNULL "g_dbus_error_new_for_dbus_error" result result' <- (wrapBoxed GError) result freeMem dbus_error_name' freeMem dbus_error_message' return result' -- function g_dbus_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_dbus_error_quark" g_dbus_error_quark :: IO Word32 dbusErrorQuark :: (MonadIO m) => m Word32 dbusErrorQuark = liftIO $ do result <- g_dbus_error_quark return result -- function g_dbus_error_register_error -- Args : [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},Arg {argName = "dbus_error_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [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},Arg {argName = "dbus_error_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_dbus_error_register_error" g_dbus_error_register_error :: Word32 -> -- error_domain : TBasicType TUInt32 Int32 -> -- error_code : TBasicType TInt32 CString -> -- dbus_error_name : TBasicType TUTF8 IO CInt dbusErrorRegisterError :: (MonadIO m) => Word32 -> -- error_domain Int32 -> -- error_code T.Text -> -- dbus_error_name m Bool dbusErrorRegisterError error_domain error_code dbus_error_name = liftIO $ do dbus_error_name' <- textToCString dbus_error_name result <- g_dbus_error_register_error error_domain error_code dbus_error_name' let result' = (/= 0) result freeMem dbus_error_name' return result' -- function g_dbus_error_register_error_domain -- Args : [Arg {argName = "error_domain_quark_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark_volatile", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TInterface "Gio" "DBusErrorEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_entries", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "error_domain_quark_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark_volatile", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TInterface "Gio" "DBusErrorEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_entries", 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_dbus_error_register_error_domain" g_dbus_error_register_error_domain :: CString -> -- error_domain_quark_name : TBasicType TUTF8 Word64 -> -- quark_volatile : TBasicType TUInt64 Ptr DBusErrorEntry -> -- entries : TInterface "Gio" "DBusErrorEntry" Word32 -> -- num_entries : TBasicType TUInt32 IO () dbusErrorRegisterErrorDomain :: (MonadIO m) => T.Text -> -- error_domain_quark_name Word64 -> -- quark_volatile DBusErrorEntry -> -- entries Word32 -> -- num_entries m () dbusErrorRegisterErrorDomain error_domain_quark_name quark_volatile entries num_entries = liftIO $ do error_domain_quark_name' <- textToCString error_domain_quark_name let entries' = unsafeManagedPtrGetPtr entries g_dbus_error_register_error_domain error_domain_quark_name' quark_volatile entries' num_entries touchManagedPtr entries freeMem error_domain_quark_name' return () -- function g_dbus_error_strip_remote_error -- Args : [Arg {argName = "error", argType = TError, 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}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_dbus_error_strip_remote_error" g_dbus_error_strip_remote_error :: Ptr GError -> -- error : TError IO CInt dbusErrorStripRemoteError :: (MonadIO m) => GError -> -- error m Bool dbusErrorStripRemoteError error_ = liftIO $ do let error_' = unsafeManagedPtrGetPtr error_ result <- g_dbus_error_strip_remote_error error_' let result' = (/= 0) result touchManagedPtr error_ return result' -- function g_dbus_error_unregister_error -- Args : [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},Arg {argName = "dbus_error_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [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},Arg {argName = "dbus_error_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_dbus_error_unregister_error" g_dbus_error_unregister_error :: Word32 -> -- error_domain : TBasicType TUInt32 Int32 -> -- error_code : TBasicType TInt32 CString -> -- dbus_error_name : TBasicType TUTF8 IO CInt dbusErrorUnregisterError :: (MonadIO m) => Word32 -> -- error_domain Int32 -> -- error_code T.Text -> -- dbus_error_name m Bool dbusErrorUnregisterError error_domain error_code dbus_error_name = liftIO $ do dbus_error_name' <- textToCString dbus_error_name result <- g_dbus_error_unregister_error error_domain error_code dbus_error_name' let result' = (/= 0) result freeMem dbus_error_name' return result' -- function g_dbus_generate_guid -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_dbus_generate_guid" g_dbus_generate_guid :: IO CString dbusGenerateGuid :: (MonadIO m) => m T.Text dbusGenerateGuid = liftIO $ do result <- g_dbus_generate_guid checkUnexpectedReturnNULL "g_dbus_generate_guid" result result' <- cstringToText result freeMem result return result' -- function g_dbus_gvalue_to_gvariant -- Args : [Arg {argName = "gvalue", argType = TInterface "GObject" "Value", 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 = "gvalue", argType = TInterface "GObject" "Value", 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 : TVariant -- throws : False -- Skip return : False foreign import ccall "g_dbus_gvalue_to_gvariant" g_dbus_gvalue_to_gvariant :: Ptr GValue -> -- gvalue : TInterface "GObject" "Value" Ptr GLib.VariantType -> -- type : TInterface "GLib" "VariantType" IO (Ptr GVariant) dbusGvalueToGvariant :: (MonadIO m) => GValue -> -- gvalue GLib.VariantType -> -- type m GVariant dbusGvalueToGvariant gvalue type_ = liftIO $ do let gvalue' = unsafeManagedPtrGetPtr gvalue let type_' = unsafeManagedPtrGetPtr type_ result <- g_dbus_gvalue_to_gvariant gvalue' type_' checkUnexpectedReturnNULL "g_dbus_gvalue_to_gvariant" result result' <- wrapGVariantPtr result touchManagedPtr gvalue touchManagedPtr type_ return result' -- function g_dbus_gvariant_to_gvalue -- Args : [Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "out_gvalue", argType = TInterface "GObject" "Value", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [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_dbus_gvariant_to_gvalue" g_dbus_gvariant_to_gvalue :: Ptr GVariant -> -- value : TVariant Ptr GValue -> -- out_gvalue : TInterface "GObject" "Value" IO () dbusGvariantToGvalue :: (MonadIO m) => GVariant -> -- value m (GValue) dbusGvariantToGvalue value = liftIO $ do let value' = unsafeManagedPtrGetPtr value out_gvalue <- callocBoxedBytes 24 :: IO (Ptr GValue) g_dbus_gvariant_to_gvalue value' out_gvalue out_gvalue' <- (wrapBoxed GValue) out_gvalue return out_gvalue' -- function g_dbus_is_address -- 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_dbus_is_address" g_dbus_is_address :: CString -> -- string : TBasicType TUTF8 IO CInt dbusIsAddress :: (MonadIO m) => T.Text -> -- string m Bool dbusIsAddress string = liftIO $ do string' <- textToCString string result <- g_dbus_is_address string' let result' = (/= 0) result freeMem string' return result' -- function g_dbus_is_guid -- 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_dbus_is_guid" g_dbus_is_guid :: CString -> -- string : TBasicType TUTF8 IO CInt dbusIsGuid :: (MonadIO m) => T.Text -> -- string m Bool dbusIsGuid string = liftIO $ do string' <- textToCString string result <- g_dbus_is_guid string' let result' = (/= 0) result freeMem string' return result' -- function g_dbus_is_interface_name -- 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_dbus_is_interface_name" g_dbus_is_interface_name :: CString -> -- string : TBasicType TUTF8 IO CInt dbusIsInterfaceName :: (MonadIO m) => T.Text -> -- string m Bool dbusIsInterfaceName string = liftIO $ do string' <- textToCString string result <- g_dbus_is_interface_name string' let result' = (/= 0) result freeMem string' return result' -- function g_dbus_is_member_name -- 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_dbus_is_member_name" g_dbus_is_member_name :: CString -> -- string : TBasicType TUTF8 IO CInt dbusIsMemberName :: (MonadIO m) => T.Text -> -- string m Bool dbusIsMemberName string = liftIO $ do string' <- textToCString string result <- g_dbus_is_member_name string' let result' = (/= 0) result freeMem string' return result' -- function g_dbus_is_name -- 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_dbus_is_name" g_dbus_is_name :: CString -> -- string : TBasicType TUTF8 IO CInt dbusIsName :: (MonadIO m) => T.Text -> -- string m Bool dbusIsName string = liftIO $ do string' <- textToCString string result <- g_dbus_is_name string' let result' = (/= 0) result freeMem string' return result' -- function g_dbus_is_supported_address -- 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 : True -- Skip return : False foreign import ccall "g_dbus_is_supported_address" g_dbus_is_supported_address :: CString -> -- string : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO CInt dbusIsSupportedAddress :: (MonadIO m) => T.Text -> -- string m () dbusIsSupportedAddress string = liftIO $ do string' <- textToCString string onException (do _ <- propagateGError $ g_dbus_is_supported_address string' freeMem string' return () ) (do freeMem string' ) -- function g_dbus_is_unique_name -- 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_dbus_is_unique_name" g_dbus_is_unique_name :: CString -> -- string : TBasicType TUTF8 IO CInt dbusIsUniqueName :: (MonadIO m) => T.Text -> -- string m Bool dbusIsUniqueName string = liftIO $ do string' <- textToCString string result <- g_dbus_is_unique_name string' let result' = (/= 0) result freeMem string' return result' -- function g_file_new_for_commandline_arg -- Args : [Arg {argName = "arg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "arg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_new_for_commandline_arg" g_file_new_for_commandline_arg :: CString -> -- arg : TBasicType TUTF8 IO (Ptr File) fileNewForCommandlineArg :: (MonadIO m) => T.Text -> -- arg m File fileNewForCommandlineArg arg = liftIO $ do arg' <- textToCString arg result <- g_file_new_for_commandline_arg arg' checkUnexpectedReturnNULL "g_file_new_for_commandline_arg" result result' <- (wrapObject File) result freeMem arg' return result' -- function g_file_new_for_commandline_arg_and_cwd -- Args : [Arg {argName = "arg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cwd", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "arg", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cwd", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_new_for_commandline_arg_and_cwd" g_file_new_for_commandline_arg_and_cwd :: CString -> -- arg : TBasicType TUTF8 CString -> -- cwd : TBasicType TUTF8 IO (Ptr File) fileNewForCommandlineArgAndCwd :: (MonadIO m) => T.Text -> -- arg T.Text -> -- cwd m File fileNewForCommandlineArgAndCwd arg cwd = liftIO $ do arg' <- textToCString arg cwd' <- textToCString cwd result <- g_file_new_for_commandline_arg_and_cwd arg' cwd' checkUnexpectedReturnNULL "g_file_new_for_commandline_arg_and_cwd" result result' <- (wrapObject File) result freeMem arg' freeMem cwd' return result' -- function g_file_new_for_path -- 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 : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_new_for_path" g_file_new_for_path :: CString -> -- path : TBasicType TUTF8 IO (Ptr File) fileNewForPath :: (MonadIO m) => T.Text -> -- path m File fileNewForPath path = liftIO $ do path' <- textToCString path result <- g_file_new_for_path path' checkUnexpectedReturnNULL "g_file_new_for_path" result result' <- (wrapObject File) result freeMem path' return result' -- function g_file_new_for_uri -- 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 : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_new_for_uri" g_file_new_for_uri :: CString -> -- uri : TBasicType TUTF8 IO (Ptr File) fileNewForUri :: (MonadIO m) => T.Text -> -- uri m File fileNewForUri uri = liftIO $ do uri' <- textToCString uri result <- g_file_new_for_uri uri' checkUnexpectedReturnNULL "g_file_new_for_uri" result result' <- (wrapObject File) result freeMem uri' return result' -- function g_file_new_tmp -- Args : [Arg {argName = "tmpl", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iostream", argType = TInterface "Gio" "FileIOStream", 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 : TInterface "Gio" "File" -- throws : True -- Skip return : False foreign import ccall "g_file_new_tmp" g_file_new_tmp :: CString -> -- tmpl : TBasicType TFileName Ptr (Ptr FileIOStream) -> -- iostream : TInterface "Gio" "FileIOStream" Ptr (Ptr GError) -> -- error IO (Ptr File) fileNewTmp :: (MonadIO m) => Maybe ([Char]) -> -- tmpl m (File,FileIOStream) fileNewTmp tmpl = liftIO $ do maybeTmpl <- case tmpl of Nothing -> return nullPtr Just jTmpl -> do jTmpl' <- stringToCString jTmpl return jTmpl' iostream <- allocMem :: IO (Ptr (Ptr FileIOStream)) onException (do result <- propagateGError $ g_file_new_tmp maybeTmpl iostream checkUnexpectedReturnNULL "g_file_new_tmp" result result' <- (wrapObject File) result iostream' <- peek iostream iostream'' <- (wrapObject FileIOStream) iostream' freeMem maybeTmpl freeMem iostream return (result', iostream'') ) (do freeMem maybeTmpl freeMem iostream ) -- function g_file_parse_name -- Args : [Arg {argName = "parse_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "parse_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "File" -- throws : False -- Skip return : False foreign import ccall "g_file_parse_name" g_file_parse_name :: CString -> -- parse_name : TBasicType TUTF8 IO (Ptr File) fileParseName :: (MonadIO m) => T.Text -> -- parse_name m File fileParseName parse_name = liftIO $ do parse_name' <- textToCString parse_name result <- g_file_parse_name parse_name' checkUnexpectedReturnNULL "g_file_parse_name" result result' <- (wrapObject File) result freeMem parse_name' return result' -- function g_icon_deserialize -- Args : [Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "value", argType = TVariant, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_icon_deserialize" g_icon_deserialize :: Ptr GVariant -> -- value : TVariant IO (Ptr Icon) iconDeserialize :: (MonadIO m) => GVariant -> -- value m Icon iconDeserialize value = liftIO $ do let value' = unsafeManagedPtrGetPtr value result <- g_icon_deserialize value' checkUnexpectedReturnNULL "g_icon_deserialize" result result' <- (wrapObject Icon) result return result' -- function g_icon_hash -- Args : [Arg {argName = "icon", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "icon", 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_icon_hash" g_icon_hash :: Ptr () -> -- icon : TBasicType TVoid IO Word32 iconHash :: (MonadIO m) => Ptr () -> -- icon m Word32 iconHash icon = liftIO $ do result <- g_icon_hash icon return result -- function g_icon_new_for_string -- 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 : TInterface "Gio" "Icon" -- throws : True -- Skip return : False foreign import ccall "g_icon_new_for_string" g_icon_new_for_string :: CString -> -- str : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr Icon) iconNewForString :: (MonadIO m) => T.Text -> -- str m Icon iconNewForString str = liftIO $ do str' <- textToCString str onException (do result <- propagateGError $ g_icon_new_for_string str' checkUnexpectedReturnNULL "g_icon_new_for_string" result result' <- (wrapObject Icon) result freeMem str' return result' ) (do freeMem str' ) -- function g_initable_newv -- Args : [Arg {argName = "object_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_parameters", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TCArray False (-1) 1 (TInterface "GObject" "Parameter"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "n_parameters", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "object_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TCArray False (-1) 1 (TInterface "GObject" "Parameter"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : True -- Skip return : False foreign import ccall "g_initable_newv" g_initable_newv :: CGType -> -- object_type : TBasicType TGType Word32 -> -- n_parameters : TBasicType TUInt32 Ptr GObject.Parameter -> -- parameters : TCArray False (-1) 1 (TInterface "GObject" "Parameter") Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO (Ptr GObject.Object) initableNewv :: (MonadIO m, CancellableK a) => GType -> -- object_type [GObject.Parameter] -> -- parameters Maybe (a) -> -- cancellable m GObject.Object initableNewv object_type parameters cancellable = liftIO $ do let n_parameters = fromIntegral $ length parameters let object_type' = gtypeToCGType object_type let parameters' = map unsafeManagedPtrGetPtr parameters parameters'' <- packBlockArray 32 parameters' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_initable_newv object_type' n_parameters parameters'' maybeCancellable checkUnexpectedReturnNULL "g_initable_newv" result result' <- (wrapObject GObject.Object) result mapM_ touchManagedPtr parameters whenJust cancellable touchManagedPtr freeMem parameters'' return result' ) (do freeMem parameters'' ) -- function g_io_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 "Gio" "IOErrorEnum" -- throws : False -- Skip return : False foreign import ccall "g_io_error_from_errno" g_io_error_from_errno :: Int32 -> -- err_no : TBasicType TInt32 IO CUInt ioErrorFromErrno :: (MonadIO m) => Int32 -> -- err_no m IOErrorEnum ioErrorFromErrno err_no = liftIO $ do result <- g_io_error_from_errno err_no let result' = (toEnum . fromIntegral) result return result' -- function g_io_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_io_error_quark" g_io_error_quark :: IO Word32 ioErrorQuark :: (MonadIO m) => m Word32 ioErrorQuark = liftIO $ do result <- g_io_error_quark return result -- function g_io_extension_point_implement -- Args : [Arg {argName = "extension_point_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "extension_name", argType = TBasicType TUTF8, 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 = "extension_point_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "extension_name", argType = TBasicType TUTF8, 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 : TInterface "Gio" "IOExtension" -- throws : False -- Skip return : False foreign import ccall "g_io_extension_point_implement" g_io_extension_point_implement :: CString -> -- extension_point_name : TBasicType TUTF8 CGType -> -- type : TBasicType TGType CString -> -- extension_name : TBasicType TUTF8 Int32 -> -- priority : TBasicType TInt32 IO (Ptr IOExtension) ioExtensionPointImplement :: (MonadIO m) => T.Text -> -- extension_point_name GType -> -- type T.Text -> -- extension_name Int32 -> -- priority m IOExtension ioExtensionPointImplement extension_point_name type_ extension_name priority = liftIO $ do extension_point_name' <- textToCString extension_point_name let type_' = gtypeToCGType type_ extension_name' <- textToCString extension_name result <- g_io_extension_point_implement extension_point_name' type_' extension_name' priority checkUnexpectedReturnNULL "g_io_extension_point_implement" result -- XXX Wrapping a foreign struct/union with no known destructor, leak? result' <- (\x -> IOExtension <$> newForeignPtr_ x) result freeMem extension_point_name' freeMem extension_name' return result' -- function g_io_extension_point_lookup -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, 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}] -- returnType : TInterface "Gio" "IOExtensionPoint" -- throws : False -- Skip return : False foreign import ccall "g_io_extension_point_lookup" g_io_extension_point_lookup :: CString -> -- name : TBasicType TUTF8 IO (Ptr IOExtensionPoint) ioExtensionPointLookup :: (MonadIO m) => T.Text -> -- name m IOExtensionPoint ioExtensionPointLookup name = liftIO $ do name' <- textToCString name result <- g_io_extension_point_lookup name' checkUnexpectedReturnNULL "g_io_extension_point_lookup" result -- XXX Wrapping a foreign struct/union with no known destructor, leak? result' <- (\x -> IOExtensionPoint <$> newForeignPtr_ x) result freeMem name' return result' -- function g_io_extension_point_register -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, 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}] -- returnType : TInterface "Gio" "IOExtensionPoint" -- throws : False -- Skip return : False foreign import ccall "g_io_extension_point_register" g_io_extension_point_register :: CString -> -- name : TBasicType TUTF8 IO (Ptr IOExtensionPoint) ioExtensionPointRegister :: (MonadIO m) => T.Text -> -- name m IOExtensionPoint ioExtensionPointRegister name = liftIO $ do name' <- textToCString name result <- g_io_extension_point_register name' checkUnexpectedReturnNULL "g_io_extension_point_register" result -- XXX Wrapping a foreign struct/union with no known destructor, leak? result' <- (\x -> IOExtensionPoint <$> newForeignPtr_ x) result freeMem name' return result' -- function g_io_modules_scan_all_in_directory -- Args : [Arg {argName = "dirname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dirname", 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_io_modules_scan_all_in_directory" g_io_modules_scan_all_in_directory :: CString -> -- dirname : TBasicType TUTF8 IO () ioModulesScanAllInDirectory :: (MonadIO m) => T.Text -> -- dirname m () ioModulesScanAllInDirectory dirname = liftIO $ do dirname' <- textToCString dirname g_io_modules_scan_all_in_directory dirname' freeMem dirname' return () -- function g_io_modules_scan_all_in_directory_with_scope -- Args : [Arg {argName = "dirname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scope", argType = TInterface "Gio" "IOModuleScope", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "dirname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scope", argType = TInterface "Gio" "IOModuleScope", 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_modules_scan_all_in_directory_with_scope" g_io_modules_scan_all_in_directory_with_scope :: CString -> -- dirname : TBasicType TUTF8 Ptr IOModuleScope -> -- scope : TInterface "Gio" "IOModuleScope" IO () ioModulesScanAllInDirectoryWithScope :: (MonadIO m) => T.Text -> -- dirname IOModuleScope -> -- scope m () ioModulesScanAllInDirectoryWithScope dirname scope = liftIO $ do dirname' <- textToCString dirname let scope' = unsafeManagedPtrGetPtr scope g_io_modules_scan_all_in_directory_with_scope dirname' scope' touchManagedPtr scope freeMem dirname' return () -- function g_io_scheduler_cancel_all_jobs -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_scheduler_cancel_all_jobs" g_io_scheduler_cancel_all_jobs :: IO () {-# DEPRECATED ioSchedulerCancelAllJobs ["You should never call this function, since you don't","know how other libraries in your program might be making use of","gioscheduler."]#-} ioSchedulerCancelAllJobs :: (MonadIO m) => m () ioSchedulerCancelAllJobs = liftIO $ do g_io_scheduler_cancel_all_jobs return () -- function g_io_scheduler_push_job -- Args : [Arg {argName = "job_func", argType = TInterface "Gio" "IOSchedulerJobFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 1, argDestroy = 2, 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 = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "job_func", argType = TInterface "Gio" "IOSchedulerJobFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 1, argDestroy = 2, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_io_scheduler_push_job" g_io_scheduler_push_job :: FunPtr IOSchedulerJobFuncC -> -- job_func : TInterface "Gio" "IOSchedulerJobFunc" Ptr () -> -- user_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- notify : TInterface "GLib" "DestroyNotify" Int32 -> -- io_priority : TBasicType TInt32 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" IO () {-# DEPRECATED ioSchedulerPushJob ["use #GThreadPool or g_task_run_in_thread()"]#-} ioSchedulerPushJob :: (MonadIO m, CancellableK a) => IOSchedulerJobFunc -> -- job_func Int32 -> -- io_priority Maybe (a) -> -- cancellable m () ioSchedulerPushJob job_func io_priority cancellable = liftIO $ do job_func' <- mkIOSchedulerJobFunc (iOSchedulerJobFuncWrapper Nothing job_func) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' let user_data = castFunPtrToPtr job_func' let notify = safeFreeFunPtrPtr g_io_scheduler_push_job job_func' user_data notify io_priority maybeCancellable whenJust cancellable touchManagedPtr return () -- function g_network_monitor_get_default -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "NetworkMonitor" -- throws : False -- Skip return : False foreign import ccall "g_network_monitor_get_default" g_network_monitor_get_default :: IO (Ptr NetworkMonitor) networkMonitorGetDefault :: (MonadIO m) => m NetworkMonitor networkMonitorGetDefault = liftIO $ do result <- g_network_monitor_get_default checkUnexpectedReturnNULL "g_network_monitor_get_default" result result' <- (newObject NetworkMonitor) result return result' -- function g_networking_init -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_networking_init" g_networking_init :: IO () networkingInit :: (MonadIO m) => m () networkingInit = liftIO $ do g_networking_init return () -- function g_pollable_source_new -- Args : [Arg {argName = "pollable_stream", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pollable_stream", argType = TInterface "GObject" "Object", 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_pollable_source_new" g_pollable_source_new :: Ptr GObject.Object -> -- pollable_stream : TInterface "GObject" "Object" IO (Ptr GLib.Source) pollableSourceNew :: (MonadIO m, GObject.ObjectK a) => a -> -- pollable_stream m GLib.Source pollableSourceNew pollable_stream = liftIO $ do let pollable_stream' = unsafeManagedPtrCastPtr pollable_stream result <- g_pollable_source_new pollable_stream' checkUnexpectedReturnNULL "g_pollable_source_new" result result' <- (wrapBoxed GLib.Source) result touchManagedPtr pollable_stream return result' -- function g_pollable_source_new_full -- Args : [Arg {argName = "pollable_stream", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pollable_stream", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Source" -- throws : False -- Skip return : False foreign import ccall "g_pollable_source_new_full" g_pollable_source_new_full :: Ptr GObject.Object -> -- pollable_stream : TInterface "GObject" "Object" Ptr GLib.Source -> -- child_source : TInterface "GLib" "Source" Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" IO (Ptr GLib.Source) pollableSourceNewFull :: (MonadIO m, GObject.ObjectK a, CancellableK b) => a -> -- pollable_stream Maybe (GLib.Source) -> -- child_source Maybe (b) -> -- cancellable m GLib.Source pollableSourceNewFull pollable_stream child_source cancellable = liftIO $ do let pollable_stream' = unsafeManagedPtrCastPtr pollable_stream maybeChild_source <- case child_source of Nothing -> return nullPtr Just jChild_source -> do let jChild_source' = unsafeManagedPtrGetPtr jChild_source return jChild_source' maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' result <- g_pollable_source_new_full pollable_stream' maybeChild_source maybeCancellable checkUnexpectedReturnNULL "g_pollable_source_new_full" result result' <- (wrapBoxed GLib.Source) result touchManagedPtr pollable_stream whenJust child_source touchManagedPtr whenJust cancellable touchManagedPtr return result' -- function g_pollable_stream_read -- Args : [Arg {argName = "stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "stream", argType = TInterface "Gio" "InputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_pollable_stream_read" g_pollable_stream_read :: Ptr InputStream -> -- stream : TInterface "Gio" "InputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 CInt -> -- blocking : TBasicType TBoolean Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 pollableStreamRead :: (MonadIO m, InputStreamK a, CancellableK b) => a -> -- stream ByteString -> -- buffer Bool -> -- blocking Maybe (b) -> -- cancellable m Int64 pollableStreamRead stream buffer blocking cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let stream' = unsafeManagedPtrCastPtr stream buffer' <- packByteString buffer let blocking' = (fromIntegral . fromEnum) blocking maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_pollable_stream_read stream' buffer' count blocking' maybeCancellable touchManagedPtr stream whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- function g_pollable_stream_write -- Args : [Arg {argName = "stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt64 -- throws : True -- Skip return : False foreign import ccall "g_pollable_stream_write" g_pollable_stream_write :: Ptr OutputStream -> -- stream : TInterface "Gio" "OutputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 CInt -> -- blocking : TBasicType TBoolean Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO Int64 pollableStreamWrite :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- stream ByteString -> -- buffer Bool -> -- blocking Maybe (b) -> -- cancellable m Int64 pollableStreamWrite stream buffer blocking cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let stream' = unsafeManagedPtrCastPtr stream buffer' <- packByteString buffer let blocking' = (fromIntegral . fromEnum) blocking maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do result <- propagateGError $ g_pollable_stream_write stream' buffer' count blocking' maybeCancellable touchManagedPtr stream whenJust cancellable touchManagedPtr freeMem buffer' return result ) (do freeMem buffer' ) -- function g_pollable_stream_write_all -- Args : [Arg {argName = "stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), 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 = "blocking", argType = TBasicType TBoolean, 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},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "count", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blocking", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_pollable_stream_write_all" g_pollable_stream_write_all :: Ptr OutputStream -> -- stream : TInterface "Gio" "OutputStream" Ptr Word8 -> -- buffer : TCArray False (-1) 2 (TBasicType TUInt8) Word64 -> -- count : TBasicType TUInt64 CInt -> -- blocking : TBasicType TBoolean Ptr Word64 -> -- bytes_written : TBasicType TUInt64 Ptr Cancellable -> -- cancellable : TInterface "Gio" "Cancellable" Ptr (Ptr GError) -> -- error IO CInt pollableStreamWriteAll :: (MonadIO m, OutputStreamK a, CancellableK b) => a -> -- stream ByteString -> -- buffer Bool -> -- blocking Maybe (b) -> -- cancellable m (Word64) pollableStreamWriteAll stream buffer blocking cancellable = liftIO $ do let count = fromIntegral $ B.length buffer let stream' = unsafeManagedPtrCastPtr stream buffer' <- packByteString buffer let blocking' = (fromIntegral . fromEnum) blocking bytes_written <- allocMem :: IO (Ptr Word64) maybeCancellable <- case cancellable of Nothing -> return nullPtr Just jCancellable -> do let jCancellable' = unsafeManagedPtrCastPtr jCancellable return jCancellable' onException (do _ <- propagateGError $ g_pollable_stream_write_all stream' buffer' count blocking' bytes_written maybeCancellable bytes_written' <- peek bytes_written touchManagedPtr stream whenJust cancellable touchManagedPtr freeMem buffer' freeMem bytes_written return bytes_written' ) (do freeMem buffer' freeMem bytes_written ) -- function g_proxy_get_default_for_protocol -- Args : [Arg {argName = "protocol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "protocol", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Proxy" -- throws : False -- Skip return : False foreign import ccall "g_proxy_get_default_for_protocol" g_proxy_get_default_for_protocol :: CString -> -- protocol : TBasicType TUTF8 IO (Ptr Proxy) proxyGetDefaultForProtocol :: (MonadIO m) => T.Text -> -- protocol m Proxy proxyGetDefaultForProtocol protocol = liftIO $ do protocol' <- textToCString protocol result <- g_proxy_get_default_for_protocol protocol' checkUnexpectedReturnNULL "g_proxy_get_default_for_protocol" result result' <- (wrapObject Proxy) result freeMem protocol' return result' -- function g_proxy_resolver_get_default -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "ProxyResolver" -- throws : False -- Skip return : False foreign import ccall "g_proxy_resolver_get_default" g_proxy_resolver_get_default :: IO (Ptr ProxyResolver) proxyResolverGetDefault :: (MonadIO m) => m ProxyResolver proxyResolverGetDefault = liftIO $ do result <- g_proxy_resolver_get_default checkUnexpectedReturnNULL "g_proxy_resolver_get_default" result result' <- (newObject ProxyResolver) result return result' -- function g_resolver_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_resolver_error_quark" g_resolver_error_quark :: IO Word32 resolverErrorQuark :: (MonadIO m) => m Word32 resolverErrorQuark = liftIO $ do result <- g_resolver_error_quark return result -- function g_resource_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_resource_error_quark" g_resource_error_quark :: IO Word32 resourceErrorQuark :: (MonadIO m) => m Word32 resourceErrorQuark = liftIO $ do result <- g_resource_error_quark return result -- function g_resource_load -- Args : [Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "filename", argType = TBasicType TFileName, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Resource" -- throws : True -- Skip return : False foreign import ccall "g_resource_load" g_resource_load :: CString -> -- filename : TBasicType TFileName Ptr (Ptr GError) -> -- error IO (Ptr Resource) resourceLoad :: (MonadIO m) => [Char] -> -- filename m Resource resourceLoad filename = liftIO $ do filename' <- stringToCString filename onException (do result <- propagateGError $ g_resource_load filename' checkUnexpectedReturnNULL "g_resource_load" result result' <- (wrapBoxed Resource) result freeMem filename' return result' ) (do freeMem filename' ) -- function g_resources_enumerate_children -- Args : [Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", 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},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", 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_resources_enumerate_children" g_resources_enumerate_children :: CString -> -- path : TBasicType TUTF8 CUInt -> -- lookup_flags : TInterface "Gio" "ResourceLookupFlags" Ptr (Ptr GError) -> -- error IO (Ptr CString) resourcesEnumerateChildren :: (MonadIO m) => T.Text -> -- path [ResourceLookupFlags] -> -- lookup_flags m [T.Text] resourcesEnumerateChildren path lookup_flags = liftIO $ do path' <- textToCString path let lookup_flags' = gflagsToWord lookup_flags onException (do result <- propagateGError $ g_resources_enumerate_children path' lookup_flags' checkUnexpectedReturnNULL "g_resources_enumerate_children" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result freeMem path' return result' ) (do freeMem path' ) -- function g_resources_get_info -- Args : [Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", 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},Arg {argName = "flags", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "g_resources_get_info" g_resources_get_info :: CString -> -- path : TBasicType TUTF8 CUInt -> -- lookup_flags : TInterface "Gio" "ResourceLookupFlags" Ptr Word64 -> -- size : TBasicType TUInt64 Ptr Word32 -> -- flags : TBasicType TUInt32 Ptr (Ptr GError) -> -- error IO CInt resourcesGetInfo :: (MonadIO m) => T.Text -> -- path [ResourceLookupFlags] -> -- lookup_flags m (Word64,Word32) resourcesGetInfo path lookup_flags = liftIO $ do path' <- textToCString path let lookup_flags' = gflagsToWord lookup_flags size <- allocMem :: IO (Ptr Word64) flags <- allocMem :: IO (Ptr Word32) onException (do _ <- propagateGError $ g_resources_get_info path' lookup_flags' size flags size' <- peek size flags' <- peek flags freeMem path' freeMem size freeMem flags return (size', flags') ) (do freeMem path' freeMem size freeMem flags ) -- function g_resources_lookup_data -- Args : [Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", 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},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "Bytes" -- throws : True -- Skip return : False foreign import ccall "g_resources_lookup_data" g_resources_lookup_data :: CString -> -- path : TBasicType TUTF8 CUInt -> -- lookup_flags : TInterface "Gio" "ResourceLookupFlags" Ptr (Ptr GError) -> -- error IO (Ptr GLib.Bytes) resourcesLookupData :: (MonadIO m) => T.Text -> -- path [ResourceLookupFlags] -> -- lookup_flags m GLib.Bytes resourcesLookupData path lookup_flags = liftIO $ do path' <- textToCString path let lookup_flags' = gflagsToWord lookup_flags onException (do result <- propagateGError $ g_resources_lookup_data path' lookup_flags' checkUnexpectedReturnNULL "g_resources_lookup_data" result result' <- (wrapBoxed GLib.Bytes) result freeMem path' return result' ) (do freeMem path' ) -- function g_resources_open_stream -- Args : [Arg {argName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", 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},Arg {argName = "lookup_flags", argType = TInterface "Gio" "ResourceLookupFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "InputStream" -- throws : True -- Skip return : False foreign import ccall "g_resources_open_stream" g_resources_open_stream :: CString -> -- path : TBasicType TUTF8 CUInt -> -- lookup_flags : TInterface "Gio" "ResourceLookupFlags" Ptr (Ptr GError) -> -- error IO (Ptr InputStream) resourcesOpenStream :: (MonadIO m) => T.Text -> -- path [ResourceLookupFlags] -> -- lookup_flags m InputStream resourcesOpenStream path lookup_flags = liftIO $ do path' <- textToCString path let lookup_flags' = gflagsToWord lookup_flags onException (do result <- propagateGError $ g_resources_open_stream path' lookup_flags' checkUnexpectedReturnNULL "g_resources_open_stream" result result' <- (wrapObject InputStream) result freeMem path' return result' ) (do freeMem path' ) -- function g_resources_register -- Args : [Arg {argName = "resource", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "resource", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_resources_register" g_resources_register :: Ptr Resource -> -- resource : TInterface "Gio" "Resource" IO () resourcesRegister :: (MonadIO m) => Resource -> -- resource m () resourcesRegister resource = liftIO $ do let resource' = unsafeManagedPtrGetPtr resource g_resources_register resource' touchManagedPtr resource return () -- function g_resources_unregister -- Args : [Arg {argName = "resource", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "resource", argType = TInterface "Gio" "Resource", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_resources_unregister" g_resources_unregister :: Ptr Resource -> -- resource : TInterface "Gio" "Resource" IO () resourcesUnregister :: (MonadIO m) => Resource -> -- resource m () resourcesUnregister resource = liftIO $ do let resource' = unsafeManagedPtrGetPtr resource g_resources_unregister resource' touchManagedPtr resource return () -- function g_settings_schema_source_get_default -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "SettingsSchemaSource" -- throws : False -- Skip return : False foreign import ccall "g_settings_schema_source_get_default" g_settings_schema_source_get_default :: IO (Ptr SettingsSchemaSource) settingsSchemaSourceGetDefault :: (MonadIO m) => m SettingsSchemaSource settingsSchemaSourceGetDefault = liftIO $ do result <- g_settings_schema_source_get_default checkUnexpectedReturnNULL "g_settings_schema_source_get_default" result result' <- (newBoxed SettingsSchemaSource) result return result' -- function g_simple_async_report_gerror_in_idle -- Args : [Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 2, 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 = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error", 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_simple_async_report_gerror_in_idle" g_simple_async_report_gerror_in_idle :: Ptr GObject.Object -> -- object : TInterface "GObject" "Object" FunPtr AsyncReadyCallbackC -> -- callback : TInterface "Gio" "AsyncReadyCallback" Ptr () -> -- user_data : TBasicType TVoid Ptr GError -> -- error : TError IO () simpleAsyncReportGerrorInIdle :: (MonadIO m, GObject.ObjectK a) => Maybe (a) -> -- object Maybe (AsyncReadyCallback) -> -- callback GError -> -- error m () simpleAsyncReportGerrorInIdle object callback error_ = liftIO $ do maybeObject <- case object of Nothing -> return nullPtr Just jObject -> do let jObject' = unsafeManagedPtrCastPtr jObject return jObject' ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC)) maybeCallback <- case callback of Nothing -> return (castPtrToFunPtr nullPtr) Just jCallback -> do jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback) poke ptrcallback jCallback' return jCallback' let error_' = unsafeManagedPtrGetPtr error_ let user_data = nullPtr g_simple_async_report_gerror_in_idle maybeObject maybeCallback user_data error_' whenJust object touchManagedPtr touchManagedPtr error_ return () -- function g_tls_backend_get_default -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gio" "TlsBackend" -- throws : False -- Skip return : False foreign import ccall "g_tls_backend_get_default" g_tls_backend_get_default :: IO (Ptr TlsBackend) tlsBackendGetDefault :: (MonadIO m) => m TlsBackend tlsBackendGetDefault = liftIO $ do result <- g_tls_backend_get_default checkUnexpectedReturnNULL "g_tls_backend_get_default" result result' <- (newObject TlsBackend) result return result' -- function g_tls_client_connection_new -- Args : [Arg {argName = "base_io_stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "server_identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_io_stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "server_identity", argType = TInterface "Gio" "SocketConnectable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsClientConnection" -- throws : True -- Skip return : False foreign import ccall "g_tls_client_connection_new" g_tls_client_connection_new :: Ptr IOStream -> -- base_io_stream : TInterface "Gio" "IOStream" Ptr SocketConnectable -> -- server_identity : TInterface "Gio" "SocketConnectable" Ptr (Ptr GError) -> -- error IO (Ptr TlsClientConnection) tlsClientConnectionNew :: (MonadIO m, IOStreamK a, SocketConnectableK b) => a -> -- base_io_stream Maybe (b) -> -- server_identity m TlsClientConnection tlsClientConnectionNew base_io_stream server_identity = liftIO $ do let base_io_stream' = unsafeManagedPtrCastPtr base_io_stream maybeServer_identity <- case server_identity of Nothing -> return nullPtr Just jServer_identity -> do let jServer_identity' = unsafeManagedPtrCastPtr jServer_identity return jServer_identity' onException (do result <- propagateGError $ g_tls_client_connection_new base_io_stream' maybeServer_identity checkUnexpectedReturnNULL "g_tls_client_connection_new" result result' <- (wrapObject TlsClientConnection) result touchManagedPtr base_io_stream whenJust server_identity touchManagedPtr return result' ) (do return () ) -- function g_tls_error_quark -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_tls_error_quark" g_tls_error_quark :: IO Word32 tlsErrorQuark :: (MonadIO m) => m Word32 tlsErrorQuark = liftIO $ do result <- g_tls_error_quark return result -- function g_tls_file_database_new -- Args : [Arg {argName = "anchors", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "anchors", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsFileDatabase" -- throws : True -- Skip return : False foreign import ccall "g_tls_file_database_new" g_tls_file_database_new :: CString -> -- anchors : TBasicType TUTF8 Ptr (Ptr GError) -> -- error IO (Ptr TlsFileDatabase) tlsFileDatabaseNew :: (MonadIO m) => T.Text -> -- anchors m TlsFileDatabase tlsFileDatabaseNew anchors = liftIO $ do anchors' <- textToCString anchors onException (do result <- propagateGError $ g_tls_file_database_new anchors' checkUnexpectedReturnNULL "g_tls_file_database_new" result result' <- (wrapObject TlsFileDatabase) result freeMem anchors' return result' ) (do freeMem anchors' ) -- function g_tls_server_connection_new -- Args : [Arg {argName = "base_io_stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "base_io_stream", argType = TInterface "Gio" "IOStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "TlsServerConnection" -- throws : True -- Skip return : False foreign import ccall "g_tls_server_connection_new" g_tls_server_connection_new :: Ptr IOStream -> -- base_io_stream : TInterface "Gio" "IOStream" Ptr TlsCertificate -> -- certificate : TInterface "Gio" "TlsCertificate" Ptr (Ptr GError) -> -- error IO (Ptr TlsServerConnection) tlsServerConnectionNew :: (MonadIO m, IOStreamK a, TlsCertificateK b) => a -> -- base_io_stream Maybe (b) -> -- certificate m TlsServerConnection tlsServerConnectionNew base_io_stream certificate = liftIO $ do let base_io_stream' = unsafeManagedPtrCastPtr base_io_stream maybeCertificate <- case certificate of Nothing -> return nullPtr Just jCertificate -> do let jCertificate' = unsafeManagedPtrCastPtr jCertificate return jCertificate' onException (do result <- propagateGError $ g_tls_server_connection_new base_io_stream' maybeCertificate checkUnexpectedReturnNULL "g_tls_server_connection_new" result result' <- (wrapObject TlsServerConnection) result touchManagedPtr base_io_stream whenJust certificate touchManagedPtr return result' ) (do return () ) -- function g_unix_is_mount_path_system_internal -- Args : [Arg {argName = "mount_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_path", 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_unix_is_mount_path_system_internal" g_unix_is_mount_path_system_internal :: CString -> -- mount_path : TBasicType TUTF8 IO CInt unixIsMountPathSystemInternal :: (MonadIO m) => T.Text -> -- mount_path m Bool unixIsMountPathSystemInternal mount_path = liftIO $ do mount_path' <- textToCString mount_path result <- g_unix_is_mount_path_system_internal mount_path' let result' = (/= 0) result freeMem mount_path' return result' -- function g_unix_mount_compare -- Args : [Arg {argName = "mount1", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount2", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount1", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mount2", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_compare" g_unix_mount_compare :: Ptr UnixMountEntry -> -- mount1 : TInterface "Gio" "UnixMountEntry" Ptr UnixMountEntry -> -- mount2 : TInterface "Gio" "UnixMountEntry" IO Int32 unixMountCompare :: (MonadIO m) => UnixMountEntry -> -- mount1 UnixMountEntry -> -- mount2 m Int32 unixMountCompare mount1 mount2 = liftIO $ do let mount1' = unsafeManagedPtrGetPtr mount1 let mount2' = unsafeManagedPtrGetPtr mount2 result <- g_unix_mount_compare mount1' mount2' touchManagedPtr mount1 touchManagedPtr mount2 return result -- function g_unix_mount_free -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_free" g_unix_mount_free :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO () unixMountFree :: (MonadIO m) => UnixMountEntry -> -- mount_entry m () unixMountFree mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry g_unix_mount_free mount_entry' touchManagedPtr mount_entry return () -- function g_unix_mount_get_device_path -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_get_device_path" g_unix_mount_get_device_path :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO CString unixMountGetDevicePath :: (MonadIO m) => UnixMountEntry -> -- mount_entry m T.Text unixMountGetDevicePath mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_get_device_path mount_entry' checkUnexpectedReturnNULL "g_unix_mount_get_device_path" result result' <- cstringToText result touchManagedPtr mount_entry return result' -- function g_unix_mount_get_fs_type -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_get_fs_type" g_unix_mount_get_fs_type :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO CString unixMountGetFsType :: (MonadIO m) => UnixMountEntry -> -- mount_entry m T.Text unixMountGetFsType mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_get_fs_type mount_entry' checkUnexpectedReturnNULL "g_unix_mount_get_fs_type" result result' <- cstringToText result touchManagedPtr mount_entry return result' -- function g_unix_mount_get_mount_path -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_get_mount_path" g_unix_mount_get_mount_path :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO CString unixMountGetMountPath :: (MonadIO m) => UnixMountEntry -> -- mount_entry m T.Text unixMountGetMountPath mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_get_mount_path mount_entry' checkUnexpectedReturnNULL "g_unix_mount_get_mount_path" result result' <- cstringToText result touchManagedPtr mount_entry return result' -- function g_unix_mount_guess_can_eject -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_guess_can_eject" g_unix_mount_guess_can_eject :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO CInt unixMountGuessCanEject :: (MonadIO m) => UnixMountEntry -> -- mount_entry m Bool unixMountGuessCanEject mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_guess_can_eject mount_entry' let result' = (/= 0) result touchManagedPtr mount_entry return result' -- function g_unix_mount_guess_icon -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_guess_icon" g_unix_mount_guess_icon :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO (Ptr Icon) unixMountGuessIcon :: (MonadIO m) => UnixMountEntry -> -- mount_entry m Icon unixMountGuessIcon mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_guess_icon mount_entry' checkUnexpectedReturnNULL "g_unix_mount_guess_icon" result result' <- (wrapObject Icon) result touchManagedPtr mount_entry return result' -- function g_unix_mount_guess_name -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_guess_name" g_unix_mount_guess_name :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO CString unixMountGuessName :: (MonadIO m) => UnixMountEntry -> -- mount_entry m T.Text unixMountGuessName mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_guess_name mount_entry' checkUnexpectedReturnNULL "g_unix_mount_guess_name" result result' <- cstringToText result freeMem result touchManagedPtr mount_entry return result' -- function g_unix_mount_guess_should_display -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_guess_should_display" g_unix_mount_guess_should_display :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO CInt unixMountGuessShouldDisplay :: (MonadIO m) => UnixMountEntry -> -- mount_entry m Bool unixMountGuessShouldDisplay mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_guess_should_display mount_entry' let result' = (/= 0) result touchManagedPtr mount_entry return result' -- function g_unix_mount_guess_symbolic_icon -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gio" "Icon" -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_guess_symbolic_icon" g_unix_mount_guess_symbolic_icon :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO (Ptr Icon) unixMountGuessSymbolicIcon :: (MonadIO m) => UnixMountEntry -> -- mount_entry m Icon unixMountGuessSymbolicIcon mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_guess_symbolic_icon mount_entry' checkUnexpectedReturnNULL "g_unix_mount_guess_symbolic_icon" result result' <- (wrapObject Icon) result touchManagedPtr mount_entry return result' -- function g_unix_mount_is_readonly -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_is_readonly" g_unix_mount_is_readonly :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO CInt unixMountIsReadonly :: (MonadIO m) => UnixMountEntry -> -- mount_entry m Bool unixMountIsReadonly mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_is_readonly mount_entry' let result' = (/= 0) result touchManagedPtr mount_entry return result' -- function g_unix_mount_is_system_internal -- Args : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "mount_entry", argType = TInterface "Gio" "UnixMountEntry", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_unix_mount_is_system_internal" g_unix_mount_is_system_internal :: Ptr UnixMountEntry -> -- mount_entry : TInterface "Gio" "UnixMountEntry" IO CInt unixMountIsSystemInternal :: (MonadIO m) => UnixMountEntry -> -- mount_entry m Bool unixMountIsSystemInternal mount_entry = liftIO $ do let mount_entry' = unsafeManagedPtrGetPtr mount_entry result <- g_unix_mount_is_system_internal mount_entry' let result' = (/= 0) result touchManagedPtr mount_entry return result' -- function g_unix_mount_points_changed_since -- Args : [Arg {argName = "time", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "time", 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_unix_mount_points_changed_since" g_unix_mount_points_changed_since :: Word64 -> -- time : TBasicType TUInt64 IO CInt unixMountPointsChangedSince :: (MonadIO m) => Word64 -> -- time m Bool unixMountPointsChangedSince time = liftIO $ do result <- g_unix_mount_points_changed_since time let result' = (/= 0) result return result' -- function g_unix_mounts_changed_since -- Args : [Arg {argName = "time", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "time", 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_unix_mounts_changed_since" g_unix_mounts_changed_since :: Word64 -> -- time : TBasicType TUInt64 IO CInt unixMountsChangedSince :: (MonadIO m) => Word64 -> -- time m Bool unixMountsChangedSince time = liftIO $ do result <- g_unix_mounts_changed_since time let result' = (/= 0) result return result' -- callback ActionEntryActivateFieldCallback actionEntryActivateFieldCallbackClosure :: ActionEntryActivateFieldCallback -> IO Closure actionEntryActivateFieldCallbackClosure cb = newCClosure =<< mkActionEntryActivateFieldCallback wrapped where wrapped = actionEntryActivateFieldCallbackWrapper Nothing cb type ActionEntryActivateFieldCallbackC = Ptr SimpleAction -> Ptr GVariant -> Ptr () -> IO () foreign import ccall "wrapper" mkActionEntryActivateFieldCallback :: ActionEntryActivateFieldCallbackC -> IO (FunPtr ActionEntryActivateFieldCallbackC) type ActionEntryActivateFieldCallback = SimpleAction -> GVariant -> IO () noActionEntryActivateFieldCallback :: Maybe ActionEntryActivateFieldCallback noActionEntryActivateFieldCallback = Nothing actionEntryActivateFieldCallbackWrapper :: Maybe (Ptr (FunPtr (ActionEntryActivateFieldCallbackC))) -> ActionEntryActivateFieldCallback -> Ptr SimpleAction -> Ptr GVariant -> Ptr () -> IO () actionEntryActivateFieldCallbackWrapper funptrptr _cb action parameter _ = do action' <- (newObject SimpleAction) action parameter' <- newGVariantFromPtr parameter _cb action' parameter' maybeReleaseFunPtr funptrptr -- callback ActionEntryChangeStateFieldCallback actionEntryChangeStateFieldCallbackClosure :: ActionEntryChangeStateFieldCallback -> IO Closure actionEntryChangeStateFieldCallbackClosure cb = newCClosure =<< mkActionEntryChangeStateFieldCallback wrapped where wrapped = actionEntryChangeStateFieldCallbackWrapper Nothing cb type ActionEntryChangeStateFieldCallbackC = Ptr SimpleAction -> Ptr GVariant -> Ptr () -> IO () foreign import ccall "wrapper" mkActionEntryChangeStateFieldCallback :: ActionEntryChangeStateFieldCallbackC -> IO (FunPtr ActionEntryChangeStateFieldCallbackC) type ActionEntryChangeStateFieldCallback = SimpleAction -> GVariant -> IO () noActionEntryChangeStateFieldCallback :: Maybe ActionEntryChangeStateFieldCallback noActionEntryChangeStateFieldCallback = Nothing actionEntryChangeStateFieldCallbackWrapper :: Maybe (Ptr (FunPtr (ActionEntryChangeStateFieldCallbackC))) -> ActionEntryChangeStateFieldCallback -> Ptr SimpleAction -> Ptr GVariant -> Ptr () -> IO () actionEntryChangeStateFieldCallbackWrapper funptrptr _cb action value _ = do action' <- (newObject SimpleAction) action value' <- newGVariantFromPtr value _cb action' value' maybeReleaseFunPtr funptrptr