{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gtk.Objects.BuilderCScope
    ( 

-- * Exported types
    BuilderCScope(..)                       ,
    IsBuilderCScope                         ,
    toBuilderCScope                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBuilderCScopeMethod              ,
#endif


-- ** addCallbackSymbol #method:addCallbackSymbol#

#if defined(ENABLE_OVERLOADING)
    BuilderCScopeAddCallbackSymbolMethodInfo,
#endif
    builderCScopeAddCallbackSymbol          ,


-- ** new #method:new#

    builderCScopeNew                        ,




    ) where

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

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

import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.BuilderScope as Gtk.BuilderScope

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

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

foreign import ccall "gtk_builder_cscope_get_type"
    c_gtk_builder_cscope_get_type :: IO B.Types.GType

instance B.Types.TypedObject BuilderCScope where
    glibType :: IO GType
glibType = IO GType
c_gtk_builder_cscope_get_type

instance B.Types.GObject BuilderCScope

-- | Convert 'BuilderCScope' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue BuilderCScope where
    toGValue :: BuilderCScope -> IO GValue
toGValue BuilderCScope
o = do
        GType
gtype <- IO GType
c_gtk_builder_cscope_get_type
        BuilderCScope -> (Ptr BuilderCScope -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BuilderCScope
o (GType
-> (GValue -> Ptr BuilderCScope -> IO ())
-> Ptr BuilderCScope
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr BuilderCScope -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO BuilderCScope
fromGValue GValue
gv = do
        Ptr BuilderCScope
ptr <- GValue -> IO (Ptr BuilderCScope)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr BuilderCScope)
        (ManagedPtr BuilderCScope -> BuilderCScope)
-> Ptr BuilderCScope -> IO BuilderCScope
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr BuilderCScope -> BuilderCScope
BuilderCScope Ptr BuilderCScope
ptr
        
    

-- | Type class for types which can be safely cast to `BuilderCScope`, for instance with `toBuilderCScope`.
class (SP.GObject o, O.IsDescendantOf BuilderCScope o) => IsBuilderCScope o
instance (SP.GObject o, O.IsDescendantOf BuilderCScope o) => IsBuilderCScope o

instance O.HasParentTypes BuilderCScope
type instance O.ParentTypes BuilderCScope = '[GObject.Object.Object, Gtk.BuilderScope.BuilderScope]

-- | Cast to `BuilderCScope`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toBuilderCScope :: (MonadIO m, IsBuilderCScope o) => o -> m BuilderCScope
toBuilderCScope :: o -> m BuilderCScope
toBuilderCScope = IO BuilderCScope -> m BuilderCScope
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BuilderCScope -> m BuilderCScope)
-> (o -> IO BuilderCScope) -> o -> m BuilderCScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr BuilderCScope -> BuilderCScope)
-> o -> IO BuilderCScope
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr BuilderCScope -> BuilderCScope
BuilderCScope

#if defined(ENABLE_OVERLOADING)
type family ResolveBuilderCScopeMethod (t :: Symbol) (o :: *) :: * where
    ResolveBuilderCScopeMethod "addCallbackSymbol" o = BuilderCScopeAddCallbackSymbolMethodInfo
    ResolveBuilderCScopeMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBuilderCScopeMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBuilderCScopeMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBuilderCScopeMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBuilderCScopeMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBuilderCScopeMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBuilderCScopeMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBuilderCScopeMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBuilderCScopeMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBuilderCScopeMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBuilderCScopeMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBuilderCScopeMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBuilderCScopeMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBuilderCScopeMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBuilderCScopeMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBuilderCScopeMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBuilderCScopeMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBuilderCScopeMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBuilderCScopeMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBuilderCScopeMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBuilderCScopeMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBuilderCScopeMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBuilderCScopeMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BuilderCScope
type instance O.AttributeList BuilderCScope = BuilderCScopeAttributeList
type BuilderCScopeAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList BuilderCScope = BuilderCScopeSignalList
type BuilderCScopeSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method BuilderCScope::add_callback_symbol
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BuilderCScope" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBuilderCScope"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The name of the callback, as expected in the XML"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback_symbol"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The callback pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_builder_cscope_add_callback_symbol" gtk_builder_cscope_add_callback_symbol :: 
    Ptr BuilderCScope ->                    -- self : TInterface (Name {namespace = "Gtk", name = "BuilderCScope"})
    CString ->                              -- callback_name : TBasicType TUTF8
    FunPtr GObject.Callbacks.C_Callback ->  -- callback_symbol : TInterface (Name {namespace = "GObject", name = "Callback"})
    IO ()

-- | Adds the /@callbackSymbol@/ to the scope of /@builder@/ under the given /@callbackName@/.
-- 
-- Using this function overrides the behavior of 'GI.Gtk.Objects.Builder.builderCreateClosure'
-- for any callback symbols that are added. Using this method allows for better
-- encapsulation as it does not require that callback symbols be declared in
-- the global namespace.
builderCScopeAddCallbackSymbol ::
    (B.CallStack.HasCallStack, MonadIO m, IsBuilderCScope a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.BuilderCScope.BuilderCScope'
    -> T.Text
    -- ^ /@callbackName@/: The name of the callback, as expected in the XML
    -> GObject.Callbacks.Callback
    -- ^ /@callbackSymbol@/: The callback pointer
    -> m ()
builderCScopeAddCallbackSymbol :: a -> Text -> IO () -> m ()
builderCScopeAddCallbackSymbol a
self Text
callbackName IO ()
callbackSymbol = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BuilderCScope
self' <- a -> IO (Ptr BuilderCScope)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
callbackName' <- Text -> IO CString
textToCString Text
callbackName
    Ptr (FunPtr (IO ()))
ptrcallbackSymbol <- IO (Ptr (FunPtr (IO ())))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GObject.Callbacks.C_Callback))
    FunPtr (IO ())
callbackSymbol' <- IO () -> IO (FunPtr (IO ()))
GObject.Callbacks.mk_Callback (Maybe (Ptr (FunPtr (IO ()))) -> IO () -> IO ()
GObject.Callbacks.wrap_Callback (Ptr (FunPtr (IO ())) -> Maybe (Ptr (FunPtr (IO ())))
forall a. a -> Maybe a
Just Ptr (FunPtr (IO ()))
ptrcallbackSymbol) IO ()
callbackSymbol)
    Ptr (FunPtr (IO ())) -> FunPtr (IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr (IO ()))
ptrcallbackSymbol FunPtr (IO ())
callbackSymbol'
    Ptr BuilderCScope -> CString -> FunPtr (IO ()) -> IO ()
gtk_builder_cscope_add_callback_symbol Ptr BuilderCScope
self' CString
callbackName' FunPtr (IO ())
callbackSymbol'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
callbackName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BuilderCScopeAddCallbackSymbolMethodInfo
instance (signature ~ (T.Text -> GObject.Callbacks.Callback -> m ()), MonadIO m, IsBuilderCScope a) => O.MethodInfo BuilderCScopeAddCallbackSymbolMethodInfo a signature where
    overloadedMethod = builderCScopeAddCallbackSymbol

#endif

-- method BuilderCScope::new
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "BuilderScope" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_builder_cscope_new" gtk_builder_cscope_new :: 
    IO (Ptr Gtk.BuilderScope.BuilderScope)

-- | Creates a new t'GI.Gtk.Objects.BuilderCScope.BuilderCScope' object to use with future t'GI.Gtk.Objects.Builder.Builder'
-- instances.
-- 
-- Calling this function is only necessary if you want to add custom
-- callbacks via 'GI.Gtk.Objects.BuilderCScope.builderCScopeAddCallbackSymbol'.
builderCScopeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gtk.BuilderScope.BuilderScope
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.BuilderCScope.BuilderCScope'
builderCScopeNew :: m BuilderScope
builderCScopeNew  = IO BuilderScope -> m BuilderScope
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BuilderScope -> m BuilderScope)
-> IO BuilderScope -> m BuilderScope
forall a b. (a -> b) -> a -> b
$ do
    Ptr BuilderScope
result <- IO (Ptr BuilderScope)
gtk_builder_cscope_new
    Text -> Ptr BuilderScope -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"builderCScopeNew" Ptr BuilderScope
result
    BuilderScope
result' <- ((ManagedPtr BuilderScope -> BuilderScope)
-> Ptr BuilderScope -> IO BuilderScope
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BuilderScope -> BuilderScope
Gtk.BuilderScope.BuilderScope) Ptr BuilderScope
result
    BuilderScope -> IO BuilderScope
forall (m :: * -> *) a. Monad m => a -> m a
return BuilderScope
result'

#if defined(ENABLE_OVERLOADING)
#endif