{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Interfaces.BuilderScope.BuilderScope' is an interface to provide support to t'GI.Gtk.Objects.Builder.Builder', primarily
-- for looking up programming-language-specific values for strings that are
-- given in a t'GI.Gtk.Objects.Builder.Builder' UI file.
-- 
-- The primary intended audience is bindings that want to provide deeper integration
-- of t'GI.Gtk.Objects.Builder.Builder' into the language.
-- 
-- A t'GI.Gtk.Interfaces.BuilderScope.BuilderScope' instance may be used with multiple t'GI.Gtk.Objects.Builder.Builder' objects, even
-- at once.
-- 
-- By default, GTK will use its own implementation of t'GI.Gtk.Interfaces.BuilderScope.BuilderScope' for the C
-- language which can be created via 'GI.Gtk.Objects.BuilderCScope.builderCScopeNew'.
-- 
-- t'GI.Gtk.Objects.BuilderCScope.BuilderCScope' instances use symbols explicitly added to /@builder@/
-- with prior calls to 'GI.Gtk.Objects.BuilderCScope.builderCScopeAddCallbackSymbol'. If developers want
-- to do that, they are encouraged to create their own scopes for that purpose.
-- 
-- In the case that symbols are not explicitly added; GTK will uses t'GI.GModule.Structs.Module.Module'’s
-- introspective features (by opening the module 'P.Nothing') to look at the application’s
-- symbol table. From here it tries to match the signal function names given in the
-- interface description with symbols in the application.
-- 
-- Note that unless 'GI.Gtk.Objects.BuilderCScope.builderCScopeAddCallbackSymbol' is called for
-- all signal callbacks which are referenced by the loaded XML, this
-- functionality will require that t'GI.GModule.Structs.Module.Module' be supported on the platform.

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

module GI.Gtk.Interfaces.BuilderScope
    ( 

-- * Exported types
    BuilderScope(..)                        ,
    IsBuilderScope                          ,
    toBuilderScope                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBuilderScopeMethod               ,
#endif




    ) 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.Objects.Object as GObject.Object

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

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

foreign import ccall "gtk_builder_scope_get_type"
    c_gtk_builder_scope_get_type :: IO B.Types.GType

instance B.Types.TypedObject BuilderScope where
    glibType :: IO GType
glibType = IO GType
c_gtk_builder_scope_get_type

instance B.Types.GObject BuilderScope

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#endif

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

#endif