{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GtkExpression provides a way to describe references to values.
-- 
-- An important aspect of expressions is that the value can be obtained
-- from a source that is several steps away. For example, an expression
-- may describe ‘the value of property A of /@object1@/, which is itself the
-- value of a property of /@object2@/’. And /@object1@/ may not even exist yet
-- at the time that the expression is created. This is contrast to GObject
-- property bindings, which can only create direct connections between
-- the properties of two objects that must both exist for the duration
-- of the binding.
-- 
-- An expression needs to be \"evaluated\" to obtain the value that it currently
-- refers to. An evaluation always happens in the context of a current object
-- called @this@ (it mirrors the behavior of object-oriented languages),
-- which may or may not influence the result of the evaluation. Use
-- 'GI.Gtk.Objects.Expression.expressionEvaluate' for evaluating an expression.
-- 
-- Various methods for defining expressions exist, from simple constants via
-- @/gtk_constant_expression_new()/@ to looking up properties in a t'GI.GObject.Objects.Object.Object' (even
-- recursively) via 'GI.Gtk.Objects.PropertyExpression.propertyExpressionNew' or providing custom functions
-- to transform and combine expressions via 'GI.Gtk.Objects.ClosureExpression.closureExpressionNew'.
-- 
-- Here is an example of a complex expression:
-- >
-- >  color_expr = gtk_property_expression_new (GTK_TYPE_LIST_ITEM,
-- >                                            NULL, "item");
-- >  expression = gtk_property_expression_new (GTK_TYPE_COLOR,
-- >                                            color_expr, "name");
-- 
-- 
-- when evaluated with @this@ being a GtkListItem, it will obtain the
-- \"item\" property from the GtkListItem, and then obtain the \"name\" property
-- from the resulting object (which is assumed to be of type GTK_TYPE_COLOR).
-- 
-- A more concise way to describe this would be
-- >
-- >  this->item->name
-- 
-- 
-- The most likely place where you will encounter expressions is in the context
-- of list models and list widgets using them. For example, t'GI.Gtk.Objects.DropDown.DropDown' is
-- evaluating a GtkExpression to obtain strings from the items in its model
-- that it can then use to match against the contents of its search entry.
-- t'GI.Gtk.Objects.StringFilter.StringFilter' is using a GtkExpression for similar reasons.
-- 
-- By default, expressions are not paying attention to changes and evaluation is
-- just a snapshot of the current state at a given time. To get informed about
-- changes, an expression needs to be \"watched\" via a t'GI.Gtk.Structs.ExpressionWatch.ExpressionWatch', which
-- will cause a callback to be called whenever the value of the expression may
-- have changed. 'GI.Gtk.Objects.Expression.expressionWatch' starts watching an expression, and
-- 'GI.Gtk.Structs.ExpressionWatch.expressionWatchUnwatch' stops.
-- 
-- Watches can be created for automatically updating the property of an object,
-- similar to GObject\'s t'GI.GObject.Objects.Binding.Binding' mechanism, by using 'GI.Gtk.Objects.Expression.expressionBind'.
-- 
-- = GtkExpression in GObject properties
-- 
-- In order to use a t'GI.Gtk.Objects.Expression.Expression' as a t'GI.GObject.Objects.Object.Object' property, you must use the
-- 'GI.Gtk.Functions.paramSpecExpression' when creating a t'GI.GObject.Objects.ParamSpec.ParamSpec' to install in the
-- t'GI.GObject.Objects.Object.Object' class being defined; for instance:
-- 
-- >
-- >  obj_props[PROP_EXPRESSION] =
-- >    gtk_param_spec_expression ("expression",
-- >                               "Expression",
-- >                               "The expression used by the widget",
-- >                               G_PARAM_READWRITE |
-- >                               G_PARAM_STATIC_STRINGS |
-- >                               G_PARAM_EXPLICIT_NOTIFY);
-- 
-- 
-- When implementing the t'GI.GObject.Structs.ObjectClass.ObjectClass'.@/set_property/@() and t'GI.GObject.Structs.ObjectClass.ObjectClass'.@/get_property/@()
-- virtual functions, you must use 'GI.Gtk.Functions.valueGetExpression', to retrieve the
-- stored t'GI.Gtk.Objects.Expression.Expression' from the t'GI.GObject.Structs.Value.Value' container, and 'GI.Gtk.Functions.valueSetExpression',
-- to store the t'GI.Gtk.Objects.Expression.Expression' into the t'GI.GObject.Structs.Value.Value'; for instance:
-- 
-- >
-- >  // in set_property()...
-- >  case PROP_EXPRESSION:
-- >    foo_widget_set_expression (foo, gtk_value_get_expression (value));
-- >    break;
-- >
-- >  // in get_property()...
-- >  case PROP_EXPRESSION:
-- >    gtk_value_set_expression (value, foo->expression);
-- >    break;
-- 
-- 
-- = GtkExpression in .ui files
-- 
-- GtkBuilder has support for creating expressions. The syntax here can be used where
-- a t'GI.Gtk.Objects.Expression.Expression' object is needed like in a \<property> tag for an expression
-- property, or in a \<binding> tag to bind a property to an expression.
-- 
-- To create an property expression, use the \<lookup> element. It can have a @type@
-- attribute to specify the object type, and a @name@ attribute to specify the property
-- to look up. The content of \<lookup> can either be an element specfiying the expression
-- to use the object, or a string that specifies the name of the object to use.
-- 
-- Example:
-- >
-- >  <lookup name='search'>string_filter</lookup>
-- 
-- 
-- To create a constant expression, use the \<constant> element. If the type attribute
-- is specified, the element content is interpreted as a value of that type. Otherwise,
-- it is assumed to be an object.
-- 
-- Example:
-- >
-- >  <constant>string_filter</constant>
-- >  <constant type='gchararray'>Hello, world</constant>
-- 
-- 
-- To create a closure expression, use the \<closure> element. The @type@ and @function@
-- attributes specify what function to use for the closure, the content of the element
-- contains the expressions for the parameters.
-- 
-- Example:
-- >
-- >  <closure type='gchararray' function='combine_args_somehow'>
-- >    <constant type='gchararray'>File size:</constant>
-- >    <lookup type='GFile' name='size'>myfile</lookup>
-- >  </closure>
-- 

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

module GI.Gtk.Objects.Expression
    ( 

-- * Exported types
    Expression(..)                          ,
    IsExpression                            ,
    toExpression                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bind]("GI.Gtk.Objects.Expression#g:method:bind"), [evaluate]("GI.Gtk.Objects.Expression#g:method:evaluate"), [isStatic]("GI.Gtk.Objects.Expression#g:method:isStatic"), [ref]("GI.Gtk.Objects.Expression#g:method:ref"), [unref]("GI.Gtk.Objects.Expression#g:method:unref"), [watch]("GI.Gtk.Objects.Expression#g:method:watch").
-- 
-- ==== Getters
-- [getValueType]("GI.Gtk.Objects.Expression#g:method:getValueType").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveExpressionMethod                 ,
#endif

-- ** bind #method:bind#

#if defined(ENABLE_OVERLOADING)
    ExpressionBindMethodInfo                ,
#endif
    expressionBind                          ,


-- ** evaluate #method:evaluate#

#if defined(ENABLE_OVERLOADING)
    ExpressionEvaluateMethodInfo            ,
#endif
    expressionEvaluate                      ,


-- ** getValueType #method:getValueType#

#if defined(ENABLE_OVERLOADING)
    ExpressionGetValueTypeMethodInfo        ,
#endif
    expressionGetValueType                  ,


-- ** isStatic #method:isStatic#

#if defined(ENABLE_OVERLOADING)
    ExpressionIsStaticMethodInfo            ,
#endif
    expressionIsStatic                      ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ExpressionRefMethodInfo                 ,
#endif
    expressionRef                           ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ExpressionUnrefMethodInfo               ,
#endif
    expressionUnref                         ,


-- ** watch #method:watch#

#if defined(ENABLE_OVERLOADING)
    ExpressionWatchMethodInfo               ,
#endif
    expressionWatch                         ,




    ) 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.GArray as B.GArray
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 GHC.Records as R

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Structs.ExpressionWatch as Gtk.ExpressionWatch

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

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

foreign import ccall "gtk_expression_get_type"
    c_gtk_expression_get_type :: IO B.Types.GType

instance B.Types.TypedObject Expression where
    glibType :: IO GType
glibType = IO GType
c_gtk_expression_get_type

-- | Type class for types which can be safely cast to `Expression`, for instance with `toExpression`.
class (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf Expression o) => IsExpression o
instance (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf Expression o) => IsExpression o

instance O.HasParentTypes Expression
type instance O.ParentTypes Expression = '[]

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

foreign import ccall "gtk_value_get_expression" gv_get_gtk_value_get_expression ::
    FP.Ptr B.GValue.GValue -> IO (FP.Ptr Expression)

foreign import ccall "gtk_value_set_expression" gv_set_gtk_value_set_expression ::
    FP.Ptr B.GValue.GValue -> FP.Ptr Expression -> IO ()

-- | Convert 'Expression' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Expression) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_expression_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Expression -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Expression
P.Nothing = Ptr GValue -> Ptr Expression -> IO ()
gv_set_gtk_value_set_expression Ptr GValue
gv (Ptr Expression
forall a. Ptr a
FP.nullPtr :: FP.Ptr Expression)
    gvalueSet_ Ptr GValue
gv (P.Just Expression
obj) = Expression -> (Ptr Expression -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Expression
obj (Ptr GValue -> Ptr Expression -> IO ()
gv_set_gtk_value_set_expression Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Expression)
gvalueGet_ Ptr GValue
gv = do
        Ptr Expression
ptr <- Ptr GValue -> IO (Ptr Expression)
gv_get_gtk_value_get_expression Ptr GValue
gv :: IO (FP.Ptr Expression)
        if Ptr Expression
ptr Ptr Expression -> Ptr Expression -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Expression
forall a. Ptr a
FP.nullPtr
        then Expression -> Maybe Expression
forall a. a -> Maybe a
P.Just (Expression -> Maybe Expression)
-> IO Expression -> IO (Maybe Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Expression -> Expression)
-> Ptr Expression -> IO Expression
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newPtr ManagedPtr Expression -> Expression
Expression Ptr Expression
ptr
        else Maybe Expression -> IO (Maybe Expression)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Expression
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveExpressionMethod (t :: Symbol) (o :: *) :: * where
    ResolveExpressionMethod "bind" o = ExpressionBindMethodInfo
    ResolveExpressionMethod "evaluate" o = ExpressionEvaluateMethodInfo
    ResolveExpressionMethod "isStatic" o = ExpressionIsStaticMethodInfo
    ResolveExpressionMethod "ref" o = ExpressionRefMethodInfo
    ResolveExpressionMethod "unref" o = ExpressionUnrefMethodInfo
    ResolveExpressionMethod "watch" o = ExpressionWatchMethodInfo
    ResolveExpressionMethod "getValueType" o = ExpressionGetValueTypeMethodInfo
    ResolveExpressionMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveExpressionMethod t Expression, O.OverloadedMethod info Expression p, R.HasField t Expression p) => R.HasField t Expression p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveExpressionMethod t Expression, O.OverloadedMethodInfo info Expression) => OL.IsLabel t (O.MethodProxy info Expression) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

foreign import ccall "gtk_expression_ref" _Expression_copy_gtk_expression_ref :: Ptr a -> IO (Ptr a)

foreign import ccall "gtk_expression_unref" _Expression_free_gtk_expression_unref :: Ptr a -> IO ()

instance BoxedPtr Expression where
    boxedPtrCopy :: Expression -> IO Expression
boxedPtrCopy = \Expression
p -> Expression -> (Ptr Expression -> IO Expression) -> IO Expression
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Expression
p (Ptr Expression -> IO (Ptr Expression)
forall a. Ptr a -> IO (Ptr a)
_Expression_copy_gtk_expression_ref (Ptr Expression -> IO (Ptr Expression))
-> (Ptr Expression -> IO Expression)
-> Ptr Expression
-> IO Expression
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr Expression -> Expression)
-> Ptr Expression -> IO Expression
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr Expression -> Expression
Expression)
    boxedPtrFree :: Expression -> IO ()
boxedPtrFree = \Expression
p -> Expression -> (Ptr Expression -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Expression
p Ptr Expression -> IO ()
forall a. Ptr a -> IO ()
_Expression_free_gtk_expression_unref


-- method Expression::bind
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkExpression" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "target"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target object to bind to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property on @target to bind to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "this_"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the this argument for\n    the evaluation of @self"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "ExpressionWatch" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_expression_bind" gtk_expression_bind :: 
    Ptr Expression ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Expression"})
    Ptr GObject.Object.Object ->            -- target : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property : TBasicType TUTF8
    Ptr GObject.Object.Object ->            -- this_ : TInterface (Name {namespace = "GObject", name = "Object"})
    IO (Ptr Gtk.ExpressionWatch.ExpressionWatch)

-- | Bind /@target@/\'s property named /@property@/ to /@self@/.
-- 
-- The value that /@self@/ evaluates to is set via @/g_object_set()/@ on
-- /@target@/. This is repeated whenever /@self@/ changes to ensure that
-- the object\'s property stays synchronized with /@self@/.
-- 
-- If /@self@/\'s evaluation fails, /@target@/\'s /@property@/ is not updated.
-- You can ensure that this doesn\'t happen by using a fallback
-- expression.
-- 
-- Note that this function takes ownership of /@self@/. If you want
-- to keep it around, you should 'GI.Gtk.Objects.Expression.expressionRef' it beforehand.
expressionBind ::
    (B.CallStack.HasCallStack, MonadIO m, IsExpression a, GObject.Object.IsObject b, GObject.Object.IsObject c) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Expression.Expression'
    -> b
    -- ^ /@target@/: the target object to bind to
    -> T.Text
    -- ^ /@property@/: name of the property on /@target@/ to bind to
    -> Maybe (c)
    -- ^ /@this_@/: the this argument for
    --     the evaluation of /@self@/
    -> m Gtk.ExpressionWatch.ExpressionWatch
    -- ^ __Returns:__ a t'GI.Gtk.Structs.ExpressionWatch.ExpressionWatch'
expressionBind :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsExpression a, IsObject b,
 IsObject c) =>
a -> b -> Text -> Maybe c -> m ExpressionWatch
expressionBind a
self b
target Text
property Maybe c
this_ = IO ExpressionWatch -> m ExpressionWatch
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExpressionWatch -> m ExpressionWatch)
-> IO ExpressionWatch -> m ExpressionWatch
forall a b. (a -> b) -> a -> b
$ do
    Ptr Expression
self' <- a -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
B.ManagedPtr.disownManagedPtr a
self
    Ptr Object
target' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
target
    CString
property' <- Text -> IO CString
textToCString Text
property
    Ptr Object
maybeThis_ <- case Maybe c
this_ of
        Maybe c
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just c
jThis_ -> do
            Ptr Object
jThis_' <- c -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jThis_
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jThis_'
    Ptr ExpressionWatch
result <- Ptr Expression
-> Ptr Object -> CString -> Ptr Object -> IO (Ptr ExpressionWatch)
gtk_expression_bind Ptr Expression
self' Ptr Object
target' CString
property' Ptr Object
maybeThis_
    Text -> Ptr ExpressionWatch -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"expressionBind" Ptr ExpressionWatch
result
    ExpressionWatch
result' <- ((ManagedPtr ExpressionWatch -> ExpressionWatch)
-> Ptr ExpressionWatch -> IO ExpressionWatch
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ExpressionWatch -> ExpressionWatch
Gtk.ExpressionWatch.ExpressionWatch) Ptr ExpressionWatch
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
target
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
this_ c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    ExpressionWatch -> IO ExpressionWatch
forall (m :: * -> *) a. Monad m => a -> m a
return ExpressionWatch
result'

#if defined(ENABLE_OVERLOADING)
data ExpressionBindMethodInfo
instance (signature ~ (b -> T.Text -> Maybe (c) -> m Gtk.ExpressionWatch.ExpressionWatch), MonadIO m, IsExpression a, GObject.Object.IsObject b, GObject.Object.IsObject c) => O.OverloadedMethod ExpressionBindMethodInfo a signature where
    overloadedMethod = expressionBind

instance O.OverloadedMethodInfo ExpressionBindMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Expression.expressionBind",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Expression.html#v:expressionBind"
        }


#endif

-- method Expression::evaluate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkExpression" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "this_"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the this argument for the evaluation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an empty #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_expression_evaluate" gtk_expression_evaluate :: 
    Ptr Expression ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Expression"})
    Ptr GObject.Object.Object ->            -- this_ : TInterface (Name {namespace = "GObject", name = "Object"})
    Ptr GValue ->                           -- value : TGValue
    IO CInt

-- | Evaluates the given expression and on success stores the result
-- in /@value@/. The t'GType' of /@value@/ will be the type given by
-- 'GI.Gtk.Objects.Expression.expressionGetValueType'.
-- 
-- It is possible that expressions cannot be evaluated - for example
-- when the expression references objects that have been destroyed or
-- set to 'P.Nothing'. In that case /@value@/ will remain empty and 'P.False'
-- will be returned.
expressionEvaluate ::
    (B.CallStack.HasCallStack, MonadIO m, IsExpression a, GObject.Object.IsObject b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Expression.Expression'
    -> Maybe (b)
    -- ^ /@this_@/: the this argument for the evaluation
    -> GValue
    -- ^ /@value@/: an empty t'GI.GObject.Structs.Value.Value'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the expression could be evaluated
expressionEvaluate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsExpression a, IsObject b) =>
a -> Maybe b -> GValue -> m Bool
expressionEvaluate a
self Maybe b
this_ GValue
value = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Expression
self' <- a -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
maybeThis_ <- case Maybe b
this_ of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jThis_ -> do
            Ptr Object
jThis_' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jThis_
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jThis_'
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CInt
result <- Ptr Expression -> Ptr Object -> Ptr GValue -> IO CInt
gtk_expression_evaluate Ptr Expression
self' Ptr Object
maybeThis_ Ptr GValue
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
this_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ExpressionEvaluateMethodInfo
instance (signature ~ (Maybe (b) -> GValue -> m Bool), MonadIO m, IsExpression a, GObject.Object.IsObject b) => O.OverloadedMethod ExpressionEvaluateMethodInfo a signature where
    overloadedMethod = expressionEvaluate

instance O.OverloadedMethodInfo ExpressionEvaluateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Expression.expressionEvaluate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Expression.html#v:expressionEvaluate"
        }


#endif

-- method Expression::get_value_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkExpression" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_expression_get_value_type" gtk_expression_get_value_type :: 
    Ptr Expression ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Expression"})
    IO CGType

-- | Gets the t'GType' that this expression evaluates to. This type
-- is constant and will not change over the lifetime of this expression.
expressionGetValueType ::
    (B.CallStack.HasCallStack, MonadIO m, IsExpression a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Expression.Expression'
    -> m GType
    -- ^ __Returns:__ The type returned from 'GI.Gtk.Objects.Expression.expressionEvaluate'
expressionGetValueType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExpression a) =>
a -> m GType
expressionGetValueType a
self = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Expression
self' <- a -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CGType
result <- Ptr Expression -> IO CGType
gtk_expression_get_value_type Ptr Expression
self'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data ExpressionGetValueTypeMethodInfo
instance (signature ~ (m GType), MonadIO m, IsExpression a) => O.OverloadedMethod ExpressionGetValueTypeMethodInfo a signature where
    overloadedMethod = expressionGetValueType

instance O.OverloadedMethodInfo ExpressionGetValueTypeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Expression.expressionGetValueType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Expression.html#v:expressionGetValueType"
        }


#endif

-- method Expression::is_static
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkExpression" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_expression_is_static" gtk_expression_is_static :: 
    Ptr Expression ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Expression"})
    IO CInt

-- | Checks if the expression is static.
-- 
-- A static expression will never change its result when
-- 'GI.Gtk.Objects.Expression.expressionEvaluate' is called on it with the same arguments.
-- 
-- That means a call to 'GI.Gtk.Objects.Expression.expressionWatch' is not necessary because
-- it will never trigger a notify.
expressionIsStatic ::
    (B.CallStack.HasCallStack, MonadIO m, IsExpression a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Expression.Expression'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the expression is static
expressionIsStatic :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExpression a) =>
a -> m Bool
expressionIsStatic a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Expression
self' <- a -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Expression -> IO CInt
gtk_expression_is_static Ptr Expression
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ExpressionIsStaticMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsExpression a) => O.OverloadedMethod ExpressionIsStaticMethodInfo a signature where
    overloadedMethod = expressionIsStatic

instance O.OverloadedMethodInfo ExpressionIsStaticMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Expression.expressionIsStatic",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Expression.html#v:expressionIsStatic"
        }


#endif

-- method Expression::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkExpression" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Expression" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_expression_ref" gtk_expression_ref :: 
    Ptr Expression ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Expression"})
    IO (Ptr Expression)

-- | Acquires a reference on the given t'GI.Gtk.Objects.Expression.Expression'.
expressionRef ::
    (B.CallStack.HasCallStack, MonadIO m, IsExpression a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Expression.Expression'
    -> m Expression
    -- ^ __Returns:__ the t'GI.Gtk.Objects.Expression.Expression' with an additional reference
expressionRef :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExpression a) =>
a -> m Expression
expressionRef a
self = IO Expression -> m Expression
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Expression -> m Expression) -> IO Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ do
    Ptr Expression
self' <- a -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Expression
result <- Ptr Expression -> IO (Ptr Expression)
gtk_expression_ref Ptr Expression
self'
    Text -> Ptr Expression -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"expressionRef" Ptr Expression
result
    Expression
result' <- ((ManagedPtr Expression -> Expression)
-> Ptr Expression -> IO Expression
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Expression -> Expression
Expression) Ptr Expression
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Expression -> IO Expression
forall (m :: * -> *) a. Monad m => a -> m a
return Expression
result'

#if defined(ENABLE_OVERLOADING)
data ExpressionRefMethodInfo
instance (signature ~ (m Expression), MonadIO m, IsExpression a) => O.OverloadedMethod ExpressionRefMethodInfo a signature where
    overloadedMethod = expressionRef

instance O.OverloadedMethodInfo ExpressionRefMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Expression.expressionRef",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Expression.html#v:expressionRef"
        }


#endif

-- method Expression::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkExpression" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_expression_unref" gtk_expression_unref :: 
    Ptr Expression ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Expression"})
    IO ()

-- | Releases a reference on the given t'GI.Gtk.Objects.Expression.Expression'.
-- 
-- If the reference was the last, the resources associated to the /@self@/ are
-- freed.
expressionUnref ::
    (B.CallStack.HasCallStack, MonadIO m, IsExpression a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Expression.Expression'
    -> m ()
expressionUnref :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExpression a) =>
a -> m ()
expressionUnref a
self = 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 Expression
self' <- a -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Expression -> IO ()
gtk_expression_unref Ptr Expression
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ExpressionUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m, IsExpression a) => O.OverloadedMethod ExpressionUnrefMethodInfo a signature where
    overloadedMethod = expressionUnref

instance O.OverloadedMethodInfo ExpressionUnrefMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Expression.expressionUnref",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Expression.html#v:expressionUnref"
        }


#endif

-- method Expression::watch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkExpression" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "this_"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `this` argument to\n    watch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ExpressionNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to invoke when the\n    expression changes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @notify callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notify for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "ExpressionWatch" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_expression_watch" gtk_expression_watch :: 
    Ptr Expression ->                       -- self : TInterface (Name {namespace = "Gtk", name = "Expression"})
    Ptr GObject.Object.Object ->            -- this_ : TInterface (Name {namespace = "GObject", name = "Object"})
    FunPtr Gtk.Callbacks.C_ExpressionNotify -> -- notify : TInterface (Name {namespace = "Gtk", name = "ExpressionNotify"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr Gtk.ExpressionWatch.ExpressionWatch)

-- | Installs a watch for the given /@expression@/ that calls the /@notify@/ function
-- whenever the evaluation of /@self@/ may have changed.
-- 
-- GTK cannot guarantee that the evaluation did indeed change when the /@notify@/
-- gets invoked, but it guarantees the opposite: When it did in fact change,
-- the /@notify@/ will be invoked.
expressionWatch ::
    (B.CallStack.HasCallStack, MonadIO m, IsExpression a, GObject.Object.IsObject b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Expression.Expression'
    -> Maybe (b)
    -- ^ /@this_@/: the @this@ argument to
    --     watch
    -> Gtk.Callbacks.ExpressionNotify
    -- ^ /@notify@/: callback to invoke when the
    --     expression changes
    -> m Gtk.ExpressionWatch.ExpressionWatch
    -- ^ __Returns:__ The newly installed watch. Note that the only
    --     reference held to the watch will be released when the watch is unwatched
    --     which can happen automatically, and not just via
    --     'GI.Gtk.Structs.ExpressionWatch.expressionWatchUnwatch'. You should call 'GI.Gtk.Structs.ExpressionWatch.expressionWatchRef'
    --     if you want to keep the watch around.
expressionWatch :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsExpression a, IsObject b) =>
a -> Maybe b -> IO () -> m ExpressionWatch
expressionWatch a
self Maybe b
this_ IO ()
notify = IO ExpressionWatch -> m ExpressionWatch
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExpressionWatch -> m ExpressionWatch)
-> IO ExpressionWatch -> m ExpressionWatch
forall a b. (a -> b) -> a -> b
$ do
    Ptr Expression
self' <- a -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
maybeThis_ <- case Maybe b
this_ of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jThis_ -> do
            Ptr Object
jThis_' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jThis_
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jThis_'
    FunPtr C_ExpressionNotify
notify' <- C_ExpressionNotify -> IO (FunPtr C_ExpressionNotify)
Gtk.Callbacks.mk_ExpressionNotify (Maybe (Ptr (FunPtr C_ExpressionNotify))
-> C_ExpressionNotify -> C_ExpressionNotify
Gtk.Callbacks.wrap_ExpressionNotify Maybe (Ptr (FunPtr C_ExpressionNotify))
forall a. Maybe a
Nothing (IO () -> C_ExpressionNotify
Gtk.Callbacks.drop_closures_ExpressionNotify IO ()
notify))
    let userData :: Ptr ()
userData = FunPtr C_ExpressionNotify -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ExpressionNotify
notify'
    let userDestroy :: FunPtr (Ptr a -> IO ())
userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr ExpressionWatch
result <- Ptr Expression
-> Ptr Object
-> FunPtr C_ExpressionNotify
-> Ptr ()
-> FunPtr C_ExpressionNotify
-> IO (Ptr ExpressionWatch)
gtk_expression_watch Ptr Expression
self' Ptr Object
maybeThis_ FunPtr C_ExpressionNotify
notify' Ptr ()
userData FunPtr C_ExpressionNotify
forall a. FunPtr (Ptr a -> IO ())
userDestroy
    Text -> Ptr ExpressionWatch -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"expressionWatch" Ptr ExpressionWatch
result
    ExpressionWatch
result' <- ((ManagedPtr ExpressionWatch -> ExpressionWatch)
-> Ptr ExpressionWatch -> IO ExpressionWatch
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ExpressionWatch -> ExpressionWatch
Gtk.ExpressionWatch.ExpressionWatch) Ptr ExpressionWatch
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
this_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    ExpressionWatch -> IO ExpressionWatch
forall (m :: * -> *) a. Monad m => a -> m a
return ExpressionWatch
result'

#if defined(ENABLE_OVERLOADING)
data ExpressionWatchMethodInfo
instance (signature ~ (Maybe (b) -> Gtk.Callbacks.ExpressionNotify -> m Gtk.ExpressionWatch.ExpressionWatch), MonadIO m, IsExpression a, GObject.Object.IsObject b) => O.OverloadedMethod ExpressionWatchMethodInfo a signature where
    overloadedMethod = expressionWatch

instance O.OverloadedMethodInfo ExpressionWatchMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.Expression.expressionWatch",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-Expression.html#v:expressionWatch"
        }


#endif