StyleProvider.hs


{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)

GtkStyleProvider is an interface used to provide style information to a 'GI.Gtk.Objects.StyleContext.StyleContext'.
See 'GI.Gtk.Objects.StyleContext.styleContextAddProvider' and 'GI.Gtk.Objects.StyleContext.styleContextAddProviderForScreen'.
-}

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

module GI.Gtk.Interfaces.StyleProvider
    ( 

-- * Exported types
    StyleProvider(..)                       ,
    noStyleProvider                         ,
    IsStyleProvider                         ,


 -- * Methods
-- ** getIconFactory #method:getIconFactory#

#if ENABLE_OVERLOADING
    StyleProviderGetIconFactoryMethodInfo   ,
#endif
    styleProviderGetIconFactory             ,


-- ** getStyle #method:getStyle#

#if ENABLE_OVERLOADING
    StyleProviderGetStyleMethodInfo         ,
#endif
    styleProviderGetStyle                   ,


-- ** getStyleProperty #method:getStyleProperty#

#if ENABLE_OVERLOADING
    StyleProviderGetStylePropertyMethodInfo ,
#endif
    styleProviderGetStyleProperty           ,




    ) 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.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.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 {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Objects.IconFactory as Gtk.IconFactory
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleProperties as Gtk.StyleProperties
import {-# SOURCE #-} qualified GI.Gtk.Structs.WidgetPath as Gtk.WidgetPath

-- interface StyleProvider 
-- | Memory-managed wrapper type.
newtype StyleProvider = StyleProvider (ManagedPtr StyleProvider)
-- | A convenience alias for `Nothing` :: `Maybe` `StyleProvider`.
noStyleProvider :: Maybe StyleProvider
noStyleProvider = Nothing

#if ENABLE_OVERLOADING
type instance O.SignalList StyleProvider = StyleProviderSignalList
type StyleProviderSignalList = ('[ ] :: [(Symbol, *)])

#endif

-- | Type class for types which implement `StyleProvider`.
class ManagedPtrNewtype a => IsStyleProvider a
instance IsStyleProvider StyleProvider
-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance WrappedPtr StyleProvider where
    wrappedPtrCalloc = return nullPtr
    wrappedPtrCopy = return
    wrappedPtrFree = Nothing


#if ENABLE_OVERLOADING
type family ResolveStyleProviderMethod (t :: Symbol) (o :: *) :: * where
    ResolveStyleProviderMethod "getIconFactory" o = StyleProviderGetIconFactoryMethodInfo
    ResolveStyleProviderMethod "getStyle" o = StyleProviderGetStyleMethodInfo
    ResolveStyleProviderMethod "getStyleProperty" o = StyleProviderGetStylePropertyMethodInfo
    ResolveStyleProviderMethod l o = O.MethodResolutionFailed l o

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

#endif

-- method StyleProvider::get_icon_factory
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "provider", argType = TInterface (Name {namespace = "Gtk", name = "StyleProvider"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GtkStyleProvider", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "path", argType = TInterface (Name {namespace = "Gtk", name = "WidgetPath"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "#GtkWidgetPath to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gtk", name = "IconFactory"}))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_style_provider_get_icon_factory" gtk_style_provider_get_icon_factory :: 
    Ptr StyleProvider ->                    -- provider : TInterface (Name {namespace = "Gtk", name = "StyleProvider"})
    Ptr Gtk.WidgetPath.WidgetPath ->        -- path : TInterface (Name {namespace = "Gtk", name = "WidgetPath"})
    IO (Ptr Gtk.IconFactory.IconFactory)

{-# DEPRECATED styleProviderGetIconFactory ["(Since version 3.8)","Will always return 'Nothing' for all GTK-provided style providers."] #-}
{- |
Returns the 'GI.Gtk.Objects.IconFactory.IconFactory' defined to be in use for /@path@/, or 'Nothing' if none
is defined.

/Since: 3.0/
-}
styleProviderGetIconFactory ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleProvider a) =>
    a
    {- ^ /@provider@/: a 'GI.Gtk.Interfaces.StyleProvider.StyleProvider' -}
    -> Gtk.WidgetPath.WidgetPath
    {- ^ /@path@/: 'GI.Gtk.Structs.WidgetPath.WidgetPath' to query -}
    -> m (Maybe Gtk.IconFactory.IconFactory)
    {- ^ __Returns:__ The icon factory to use for /@path@/, or 'Nothing' -}
styleProviderGetIconFactory provider path = liftIO $ do
    provider' <- unsafeManagedPtrCastPtr provider
    path' <- unsafeManagedPtrGetPtr path
    result <- gtk_style_provider_get_icon_factory provider' path'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (newObject Gtk.IconFactory.IconFactory) result'
        return result''
    touchManagedPtr provider
    touchManagedPtr path
    return maybeResult

#if ENABLE_OVERLOADING
data StyleProviderGetIconFactoryMethodInfo
instance (signature ~ (Gtk.WidgetPath.WidgetPath -> m (Maybe Gtk.IconFactory.IconFactory)), MonadIO m, IsStyleProvider a) => O.MethodInfo StyleProviderGetIconFactoryMethodInfo a signature where
    overloadedMethod _ = styleProviderGetIconFactory

#endif

-- method StyleProvider::get_style
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "provider", argType = TInterface (Name {namespace = "Gtk", name = "StyleProvider"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GtkStyleProvider", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "path", argType = TInterface (Name {namespace = "Gtk", name = "WidgetPath"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "#GtkWidgetPath to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gtk", name = "StyleProperties"}))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_style_provider_get_style" gtk_style_provider_get_style :: 
    Ptr StyleProvider ->                    -- provider : TInterface (Name {namespace = "Gtk", name = "StyleProvider"})
    Ptr Gtk.WidgetPath.WidgetPath ->        -- path : TInterface (Name {namespace = "Gtk", name = "WidgetPath"})
    IO (Ptr Gtk.StyleProperties.StyleProperties)

{-# DEPRECATED styleProviderGetStyle ["(Since version 3.8)","Will always return 'Nothing' for all GTK-provided style providers","    as the interface cannot correctly work the way CSS is specified."] #-}
{- |
Returns the style settings affecting a widget defined by /@path@/, or 'Nothing' if
/@provider@/ doesn’t contemplate styling /@path@/.

/Since: 3.0/
-}
styleProviderGetStyle ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleProvider a) =>
    a
    {- ^ /@provider@/: a 'GI.Gtk.Interfaces.StyleProvider.StyleProvider' -}
    -> Gtk.WidgetPath.WidgetPath
    {- ^ /@path@/: 'GI.Gtk.Structs.WidgetPath.WidgetPath' to query -}
    -> m (Maybe Gtk.StyleProperties.StyleProperties)
    {- ^ __Returns:__ a 'GI.Gtk.Objects.StyleProperties.StyleProperties' containing the
style settings affecting /@path@/ -}
styleProviderGetStyle provider path = liftIO $ do
    provider' <- unsafeManagedPtrCastPtr provider
    path' <- unsafeManagedPtrGetPtr path
    result <- gtk_style_provider_get_style provider' path'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapObject Gtk.StyleProperties.StyleProperties) result'
        return result''
    touchManagedPtr provider
    touchManagedPtr path
    return maybeResult

#if ENABLE_OVERLOADING
data StyleProviderGetStyleMethodInfo
instance (signature ~ (Gtk.WidgetPath.WidgetPath -> m (Maybe Gtk.StyleProperties.StyleProperties)), MonadIO m, IsStyleProvider a) => O.MethodInfo StyleProviderGetStyleMethodInfo a signature where
    overloadedMethod _ = styleProviderGetStyle

#endif

-- method StyleProvider::get_style_property
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "provider", argType = TInterface (Name {namespace = "Gtk", name = "StyleProvider"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GtkStyleProvider", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "path", argType = TInterface (Name {namespace = "Gtk", name = "WidgetPath"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "#GtkWidgetPath to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "state", argType = TInterface (Name {namespace = "Gtk", name = "StateFlags"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "state to query the style property for", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #GParamSpec to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "value", argType = TInterface (Name {namespace = "GObject", name = "Value"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "return location for the property value", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = True, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_style_provider_get_style_property" gtk_style_provider_get_style_property :: 
    Ptr StyleProvider ->                    -- provider : TInterface (Name {namespace = "Gtk", name = "StyleProvider"})
    Ptr Gtk.WidgetPath.WidgetPath ->        -- path : TInterface (Name {namespace = "Gtk", name = "WidgetPath"})
    CUInt ->                                -- state : TInterface (Name {namespace = "Gtk", name = "StateFlags"})
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    Ptr GValue ->                           -- value : TInterface (Name {namespace = "GObject", name = "Value"})
    IO CInt

{- |
Looks up a widget style property as defined by /@provider@/ for
the widget represented by /@path@/.

/Since: 3.0/
-}
styleProviderGetStyleProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleProvider a) =>
    a
    {- ^ /@provider@/: a 'GI.Gtk.Interfaces.StyleProvider.StyleProvider' -}
    -> Gtk.WidgetPath.WidgetPath
    {- ^ /@path@/: 'GI.Gtk.Structs.WidgetPath.WidgetPath' to query -}
    -> [Gtk.Flags.StateFlags]
    {- ^ /@state@/: state to query the style property for -}
    -> GParamSpec
    {- ^ /@pspec@/: The 'GI.GObject.Objects.ParamSpec.ParamSpec' to query -}
    -> m ((Bool, GValue))
    {- ^ __Returns:__ 'True' if the property was found and has a value, 'False' otherwise -}
styleProviderGetStyleProperty provider path state pspec = liftIO $ do
    provider' <- unsafeManagedPtrCastPtr provider
    path' <- unsafeManagedPtrGetPtr path
    let state' = gflagsToWord state
    pspec' <- unsafeManagedPtrGetPtr pspec
    value <- callocBoxedBytes 24 :: IO (Ptr GValue)
    result <- gtk_style_provider_get_style_property provider' path' state' pspec' value
    let result' = (/= 0) result
    value' <- (wrapBoxed GValue) value
    touchManagedPtr provider
    touchManagedPtr path
    touchManagedPtr pspec
    return (result', value')

#if ENABLE_OVERLOADING
data StyleProviderGetStylePropertyMethodInfo
instance (signature ~ (Gtk.WidgetPath.WidgetPath -> [Gtk.Flags.StateFlags] -> GParamSpec -> m ((Bool, GValue))), MonadIO m, IsStyleProvider a) => O.MethodInfo StyleProviderGetStylePropertyMethodInfo a signature where
    overloadedMethod _ = styleProviderGetStyleProperty

#endif