{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
--
-- == Basic attributes interface
--
-- Attributes of an object can be get, set and constructed. For types
-- descending from 'Data.GI.Base.BasicTypes.GObject', properties are
-- encoded in attributes, although attributes are slightly more
-- general (every property of a `Data.GI.Base.BasicTypes.GObject` is an
-- attribute, but we can also have attributes for types not descending
-- from `Data.GI.Base.BasicTypes.GObject`).
--
-- If you're wondering what the possible attributes of a GObject are,
-- look at the list of properties in the documentation, e.g. the
-- Properties heading of the docs for 'GI.Gtk.Objects.Button' lists
-- properties such as @image@ and @relief@. Parent classes may also
-- introduce properties, so since a Button is an instance of
-- @IsActionable@, it inherits properties like @actionName@ from
-- 'GI.Gtk.Interfaces.Actionable' too.
--
-- As an example consider a @button@ widget and a property (of the
-- Button class, or any of its parent classes or implemented
-- interfaces) called "label". The simplest way of getting the value
-- of the button is to do
--
-- > value <- getButtonLabel button
--
-- And for setting:
--
-- > setButtonLabel button label
--
-- This mechanism quickly becomes rather cumbersome, for example for
-- setting the "window" property in a DOMDOMWindow in WebKit:
--
-- > win <- getDOMDOMWindowWindow dom
--
-- and perhaps more importantly, one needs to chase down the type
-- which introduces the property:
--
-- > setWidgetSensitive button False
--
-- There is no @setButtonSensitive@, since it is the @Widget@ type
-- that introduces the "sensitive" property.
--
-- == Overloaded attributes
--
-- A much more convenient overloaded attribute resolution API is
-- provided by this module. Getting the value of an object's attribute
-- is straightforward:
--
-- > value <- get button _label
--
-- The definition of @_label@ is basically a 'Proxy' encoding the name
-- of the attribute to get:
--
-- > _label = fromLabelProxy (Proxy :: Proxy "label")
--
-- These proxies can be automatically generated by invoking the code
-- generator with the @-l@ option. The leading underscore is simply so
-- the autogenerated identifiers do not pollute the namespace, but if
-- this is not a concern the autogenerated names (in the autogenerated
-- @GI/Properties.hs@) can be edited as one wishes.
--
-- In addition, for ghc >= 8.0, one can directly use the overloaded
-- labels provided by GHC itself. Using the "OverloadedLabels"
-- extension, the code above can also be written as
--
-- > value <- get button #label
--
-- The syntax for setting or updating an attribute is only slightly more
-- complex. At the simplest level it is just:
--
-- > set button [ _label := value ]
--
-- or for the WebKit example above
--
-- > set dom [_window := win]
--
-- However as the list notation would indicate, you can set or update multiple
-- attributes of the same object in one go:
--
-- > set button [ _label := value, _sensitive := False ]
--
-- You are not limited to setting the value of an attribute, you can also
-- apply an update function to an attribute's value. That is the function
-- receives the current value of the attribute and returns the new value.
--
-- > set spinButton [ _value :~ (+1) ]
--
-- There are other variants of these operators, see 'AttrOp'
-- below. ':=>' and ':~>' are like ':=' and ':~' but operate in the
-- 'IO' monad rather than being pure.
--
-- Attributes can also be set during construction of a
-- `Data.GI.Base.BasicTypes.GObject` using `Data.GI.Base.Constructible.new`
--
-- > button <- new Button [_label := "Can't touch this!", _sensitive := False]
--
-- In addition for value being set/get having to have the right type,
-- there can be attributes that are read-only, or that can only be set
-- during construction with `Data.GI.Base.Properties.new`, but cannot be
-- `set` afterwards. That these invariants hold is also checked during
-- compile time.
--
-- == Nullable attributes
--
-- Whenever the attribute is represented as a pointer in the C side,
-- it is often the case that the underlying C representation admits or
-- returns @NULL@ as a valid value for the property. In these cases
-- the `get` operation may return a `Maybe` value, with `Nothing`
-- representing the @NULL@ pointer value (notable exceptions are
-- `Data.GI.Base.BasicTypes.GList` and
-- `Data.GI.Base.BasicTypes.GSList`, for which @NULL@ is represented
-- simply as the empty list). This can be overridden in the
-- introspection data, since sometimes attributes are non-nullable,
-- even if the type would allow for @NULL@.
--
-- For convenience, in nullable cases the `set` operation will by
-- default /not/ take a `Maybe` value, but rather assume that the
-- caller wants to set a non-@NULL@ value. If setting a @NULL@ value
-- is desired, use `clear` as follows
--
-- > clear object _propName
--
module Data.GI.Base.Attributes (
  AttrInfo(..),

  AttrOpTag(..),

  AttrOp(..),
  AttrOpAllowed,

  AttrGetC,
  AttrSetC,
  AttrConstructC,
  AttrClearC,

  get,
  set,
  clear,

  AttrLabelProxy(..),

  resolveAttr,
  bindPropToField,

  EqMaybe(..)
  ) where

import Control.Monad (void, when)
import Control.Monad.IO.Class (MonadIO, liftIO)

import Data.GI.Base.BasicTypes (GObject)
import Data.GI.Base.DynVal (DynVal(..), ModelProxy, DVKey(..),
                            modelProxyCurrentValue, modelProxyRegisterHandler,
                            modelProxyUpdate, dvKeys, dvRead)
import Data.GI.Base.GValue (GValueConstruct)
import Data.GI.Base.Overloading (HasAttributeList, ResolveAttribute,
                                 ResolvedSymbolInfo)
import Data.GI.Base.Internal.PathFieldAccess (PathFieldAccess(..), Components)

import {-# SOURCE #-} Data.GI.Base.Signals (SignalInfo(..),
                                            SignalProxy,
                                            on, after, connectGObjectNotify,
                                            SignalConnectMode(..))

import Data.Kind (Type)
import Data.Proxy (Proxy(..))
import qualified Data.Text as T

import GHC.TypeLits (Symbol, KnownSymbol, ErrorMessage(..), TypeError,
                     symbolVal)
import GHC.Exts (Constraint)

import GHC.OverloadedLabels (IsLabel(..))
import qualified Optics.Core as O

infixr 0 :=,:~,:=>,:~>,:<~,:!<~

-- | A proxy for attribute labels.
data AttrLabelProxy (a :: Symbol) = AttrLabelProxy

#if MIN_VERSION_base(4,10,0)
instance a ~ x => IsLabel x (AttrLabelProxy a) where
    fromLabel :: AttrLabelProxy a
fromLabel = AttrLabelProxy a
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
#else
instance a ~ x => IsLabel x (AttrLabelProxy a) where
    fromLabel _ = AttrLabelProxy
#endif

-- | Info describing an attribute.
class AttrInfo (info :: Type) where
    -- | The operations that are allowed on the attribute.
    type AttrAllowedOps info :: [AttrOpTag]

    -- | Constraint on the type for which we are allowed to
    -- create\/set\/get the attribute.
    type AttrBaseTypeConstraint info :: Type -> Constraint

    -- | Type returned by `attrGet`.
    type AttrGetType info

    -- | Constraint on the value being set.
    type AttrSetTypeConstraint info :: Type -> Constraint
    type AttrSetTypeConstraint info = (~) (AttrGetType info)

    -- | Constraint on the value being set, with allocation allowed
    -- (see ':&=' below).
    type AttrTransferTypeConstraint info :: Type -> Constraint
    type AttrTransferTypeConstraint info = (~) (AttrTransferType info)

    -- | Type resulting from the allocation.
    type AttrTransferType info :: Type
    type AttrTransferType info = AttrGetType info

    -- | Name of the attribute.
    type AttrLabel info :: Symbol

    -- | Type which introduces the attribute.
    type AttrOrigin info

    -- | Get the value of the given attribute.
    attrGet :: AttrBaseTypeConstraint info o =>
               o -> IO (AttrGetType info)
    default attrGet :: -- Make sure that a non-default method
                       -- implementation is provided if AttrGet
                       -- is set.
                        CheckNotElem 'AttrGet (AttrAllowedOps info)
                         (GetNotProvidedError info) =>
                       o -> IO (AttrGetType info)
    attrGet = o -> IO (AttrGetType info)
forall a. HasCallStack => a
undefined

    -- | Set the value of the given attribute, after the object having
    -- the attribute has already been created.
    attrSet :: (AttrBaseTypeConstraint info o,
                AttrSetTypeConstraint info b) =>
               o -> b -> IO ()
    default attrSet :: -- Make sure that a non-default method
                        -- implementation is provided if AttrSet
                        -- is set.
                        CheckNotElem 'AttrSet (AttrAllowedOps info)
                         (SetNotProvidedError info) =>
                       o -> b -> IO ()
    attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined

    -- | Set the value of the given attribute to @NULL@ (for nullable
    -- attributes).
    attrClear :: AttrBaseTypeConstraint info o =>
                 o -> IO ()
    default attrClear ::  -- Make sure that a non-default method
                          -- implementation is provided if AttrClear
                          -- is set.
                          CheckNotElem 'AttrClear (AttrAllowedOps info)
                                       (ClearNotProvidedError info) =>
                      o -> IO ()
    attrClear = o -> IO ()
forall a. HasCallStack => a
undefined

    -- | Build a `Data.GI.Base.GValue.GValue` representing the attribute.
    attrConstruct :: (AttrBaseTypeConstraint info o,
                      AttrSetTypeConstraint info b) =>
                     b -> IO (GValueConstruct o)
    default attrConstruct :: -- Make sure that a non-default method
                             -- implementation is provided if AttrConstruct
                             -- is set.
                             CheckNotElem 'AttrConstruct (AttrAllowedOps info)
                               (ConstructNotProvidedError info) =>
                      b -> IO (GValueConstruct o)
    attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined

    -- | Allocate memory as necessary to generate a settable type from
    -- the transfer type. This is useful for types which needs
    -- allocations for marshalling from Haskell to C, this makes the
    -- allocation explicit.
    attrTransfer :: forall o b. (AttrBaseTypeConstraint info o,
                               AttrTransferTypeConstraint info b) =>
                    Proxy o -> b -> IO (AttrTransferType info)
    default attrTransfer :: forall o b. (AttrBaseTypeConstraint info o,
                             AttrTransferTypeConstraint info b,
                             b ~ AttrGetType info,
                             b ~ AttrTransferType info) =>
                            Proxy o -> b -> IO (AttrTransferType info)
    attrTransfer Proxy o
_ = b -> IO b
b -> IO (AttrTransferType info)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

    -- | Like `attrSet`, but it uses the same type as the getter. This
    -- is useful for some nullable types, for which the getter returns
    -- @Maybe a@, while the setter takes an @a@. `attrPut` will
    -- instead accept an @Maybe a@.
    attrPut :: AttrBaseTypeConstraint info o =>
               o -> AttrGetType info -> IO ()
    default attrPut :: -- Make sure that a non-default method
                       -- implementation is provided if AttrSet
                       -- is set.
                        CheckNotElem 'AttrPut (AttrAllowedOps info)
                         (PutNotProvidedError info) =>
                       o -> AttrGetType info -> IO ()
    attrPut = o -> AttrGetType info -> IO ()
forall a. HasCallStack => a
undefined

    -- | Return some information about the overloaded attribute,
    -- useful for debugging. See `resolveAttr` for how to access this
    -- conveniently.
    dbgAttrInfo :: Maybe ResolvedSymbolInfo
    dbgAttrInfo = Maybe ResolvedSymbolInfo
forall a. Maybe a
Nothing

-- | Pretty print a type, indicating the parent type that introduced
-- the attribute, if different.
type family TypeOriginInfo definingType useType :: ErrorMessage where
    TypeOriginInfo definingType definingType =
        'Text "‘" ':<>: 'ShowType definingType ':<>: 'Text "’"
    TypeOriginInfo definingType useType =
        'Text "‘" ':<>: 'ShowType useType ':<>:
        'Text "’ (inherited from parent type ‘" ':<>:
        'ShowType definingType ':<>: 'Text "’)"

-- | Look in the given list to see if the given `AttrOp` is a member,
-- if not return an error type.
type family AttrOpIsAllowed (tag :: AttrOpTag) (ops :: [AttrOpTag]) (label :: Symbol) (definingType :: Type) (useType :: Type) :: Constraint where
    AttrOpIsAllowed tag '[] label definingType useType =
        TypeError ('Text "Attribute ‘" ':<>: 'Text label ':<>:
                   'Text "’ for type " ':<>:
                   TypeOriginInfo definingType useType ':<>:
                   'Text " is not " ':<>:
                   'Text (AttrOpText tag) ':<>: 'Text ".")
    AttrOpIsAllowed tag (tag ': ops) label definingType useType = ()
    AttrOpIsAllowed tag (other ': ops) label definingType useType = AttrOpIsAllowed tag ops label definingType useType

-- | Whether a given `AttrOpTag` is allowed on an attribute, given the
-- info type.
type family AttrOpAllowed (tag :: AttrOpTag) (info :: Type) (useType :: Type) :: Constraint where
    AttrOpAllowed tag info useType =
        AttrOpIsAllowed tag (AttrAllowedOps info) (AttrLabel info) (AttrOrigin info) useType

-- | Error to be raised when an operation is allowed, but an
-- implementation has not been provided.
type family OpNotProvidedError (info :: o) (op :: AttrOpTag) (methodName :: Symbol) :: ErrorMessage where
  OpNotProvidedError info op methodName =
    'Text "The attribute ‘" ':<>: 'Text (AttrLabel info) ':<>:
    'Text "’ for type ‘" ':<>:
    'ShowType (AttrOrigin info) ':<>:
    'Text "’ is declared as " ':<>:
    'Text (AttrOpText op) ':<>:
    'Text ", but no implementation of ‘" ':<>:
    'Text methodName ':<>:
    'Text "’ has been provided."
    ':$$: 'Text "Either provide an implementation of ‘" ':<>:
    'Text methodName ':<>:
    'Text "’ or remove ‘" ':<>:
    'ShowType op ':<>:
    'Text "’ from ‘AttrAllowedOps’."

-- | Error to be raised when AttrClear is allowed, but an
-- implementation has not been provided.
type family ClearNotProvidedError (info :: o) :: ErrorMessage where
  ClearNotProvidedError info = OpNotProvidedError info 'AttrClear "attrClear"

-- | Error to be raised when AttrGet is allowed, but an
-- implementation has not been provided.
type family GetNotProvidedError (info :: o) :: ErrorMessage where
  GetNotProvidedError info = OpNotProvidedError info 'AttrGet "attrGet"

-- | Error to be raised when AttrSet is allowed, but an
-- implementation has not been provided.
type family SetNotProvidedError (info :: o) :: ErrorMessage where
  SetNotProvidedError info = OpNotProvidedError info 'AttrSet "attrSet"

-- | Error to be raised when AttrSet is allowed, but an `attrPut`
-- implementation has not been provided.
type family PutNotProvidedError (info :: o) :: ErrorMessage where
  PutNotProvidedError info = OpNotProvidedError info 'AttrSet "attrPut"

-- | Error to be raised when AttrConstruct is allowed, but an
-- implementation has not been provided.
type family ConstructNotProvidedError (info :: o) :: ErrorMessage where
  ConstructNotProvidedError info = OpNotProvidedError info 'AttrConstruct "attrConstruct"

-- | Check if the given element is a member, and if so raise the given
-- error.
type family CheckNotElem (a :: k) (as :: [k]) (msg :: ErrorMessage) :: Constraint where
  CheckNotElem a '[] msg = ()
  CheckNotElem a (a ': rest) msg = TypeError msg
  CheckNotElem a (other ': rest) msg = CheckNotElem a rest msg

-- | Possible operations on an attribute.
data AttrOpTag = AttrGet
               -- ^ It is possible to read the value of the attribute
               -- with `get`.
               | AttrSet
               -- ^ It is possible to write the value of the attribute
               -- with `set`.
               | AttrConstruct
               -- ^ It is possible to set the value of the attribute
               -- in `Data.GI.Base.Constructible.new`.
               | AttrClear
               -- ^ It is possible to clear the value of the
               -- (nullable) attribute with `clear`.
               | AttrPut
               -- ^ It is possible to set a value of the same type as
               -- the one returned by `get`.
  deriving (AttrOpTag -> AttrOpTag -> Bool
(AttrOpTag -> AttrOpTag -> Bool)
-> (AttrOpTag -> AttrOpTag -> Bool) -> Eq AttrOpTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttrOpTag -> AttrOpTag -> Bool
== :: AttrOpTag -> AttrOpTag -> Bool
$c/= :: AttrOpTag -> AttrOpTag -> Bool
/= :: AttrOpTag -> AttrOpTag -> Bool
Eq, Eq AttrOpTag
Eq AttrOpTag =>
(AttrOpTag -> AttrOpTag -> Ordering)
-> (AttrOpTag -> AttrOpTag -> Bool)
-> (AttrOpTag -> AttrOpTag -> Bool)
-> (AttrOpTag -> AttrOpTag -> Bool)
-> (AttrOpTag -> AttrOpTag -> Bool)
-> (AttrOpTag -> AttrOpTag -> AttrOpTag)
-> (AttrOpTag -> AttrOpTag -> AttrOpTag)
-> Ord AttrOpTag
AttrOpTag -> AttrOpTag -> Bool
AttrOpTag -> AttrOpTag -> Ordering
AttrOpTag -> AttrOpTag -> AttrOpTag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AttrOpTag -> AttrOpTag -> Ordering
compare :: AttrOpTag -> AttrOpTag -> Ordering
$c< :: AttrOpTag -> AttrOpTag -> Bool
< :: AttrOpTag -> AttrOpTag -> Bool
$c<= :: AttrOpTag -> AttrOpTag -> Bool
<= :: AttrOpTag -> AttrOpTag -> Bool
$c> :: AttrOpTag -> AttrOpTag -> Bool
> :: AttrOpTag -> AttrOpTag -> Bool
$c>= :: AttrOpTag -> AttrOpTag -> Bool
>= :: AttrOpTag -> AttrOpTag -> Bool
$cmax :: AttrOpTag -> AttrOpTag -> AttrOpTag
max :: AttrOpTag -> AttrOpTag -> AttrOpTag
$cmin :: AttrOpTag -> AttrOpTag -> AttrOpTag
min :: AttrOpTag -> AttrOpTag -> AttrOpTag
Ord, Int -> AttrOpTag
AttrOpTag -> Int
AttrOpTag -> [AttrOpTag]
AttrOpTag -> AttrOpTag
AttrOpTag -> AttrOpTag -> [AttrOpTag]
AttrOpTag -> AttrOpTag -> AttrOpTag -> [AttrOpTag]
(AttrOpTag -> AttrOpTag)
-> (AttrOpTag -> AttrOpTag)
-> (Int -> AttrOpTag)
-> (AttrOpTag -> Int)
-> (AttrOpTag -> [AttrOpTag])
-> (AttrOpTag -> AttrOpTag -> [AttrOpTag])
-> (AttrOpTag -> AttrOpTag -> [AttrOpTag])
-> (AttrOpTag -> AttrOpTag -> AttrOpTag -> [AttrOpTag])
-> Enum AttrOpTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AttrOpTag -> AttrOpTag
succ :: AttrOpTag -> AttrOpTag
$cpred :: AttrOpTag -> AttrOpTag
pred :: AttrOpTag -> AttrOpTag
$ctoEnum :: Int -> AttrOpTag
toEnum :: Int -> AttrOpTag
$cfromEnum :: AttrOpTag -> Int
fromEnum :: AttrOpTag -> Int
$cenumFrom :: AttrOpTag -> [AttrOpTag]
enumFrom :: AttrOpTag -> [AttrOpTag]
$cenumFromThen :: AttrOpTag -> AttrOpTag -> [AttrOpTag]
enumFromThen :: AttrOpTag -> AttrOpTag -> [AttrOpTag]
$cenumFromTo :: AttrOpTag -> AttrOpTag -> [AttrOpTag]
enumFromTo :: AttrOpTag -> AttrOpTag -> [AttrOpTag]
$cenumFromThenTo :: AttrOpTag -> AttrOpTag -> AttrOpTag -> [AttrOpTag]
enumFromThenTo :: AttrOpTag -> AttrOpTag -> AttrOpTag -> [AttrOpTag]
Enum, AttrOpTag
AttrOpTag -> AttrOpTag -> Bounded AttrOpTag
forall a. a -> a -> Bounded a
$cminBound :: AttrOpTag
minBound :: AttrOpTag
$cmaxBound :: AttrOpTag
maxBound :: AttrOpTag
Bounded, Int -> AttrOpTag -> ShowS
[AttrOpTag] -> ShowS
AttrOpTag -> String
(Int -> AttrOpTag -> ShowS)
-> (AttrOpTag -> String)
-> ([AttrOpTag] -> ShowS)
-> Show AttrOpTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttrOpTag -> ShowS
showsPrec :: Int -> AttrOpTag -> ShowS
$cshow :: AttrOpTag -> String
show :: AttrOpTag -> String
$cshowList :: [AttrOpTag] -> ShowS
showList :: [AttrOpTag] -> ShowS
Show)

-- | A user friendly description of the `AttrOpTag`, useful when
-- printing type errors.
type family AttrOpText (tag :: AttrOpTag) :: Symbol where
    AttrOpText 'AttrGet = "gettable"
    AttrOpText 'AttrSet = "settable"
    AttrOpText 'AttrConstruct = "constructible"
    AttrOpText 'AttrClear = "nullable"
    AttrOpText 'AttrPut = "puttable"

-- | Constraint on a @obj@\/@attr@ pair so that `set` works on values
-- of type @value@.
type AttrSetC info obj attr value = (HasAttributeList obj,
                                     info ~ ResolveAttribute attr obj,
                                     AttrInfo info,
                                     AttrBaseTypeConstraint info obj,
                                     AttrOpAllowed 'AttrSet info obj,
                                     (AttrSetTypeConstraint info) value)

-- | Constraint on a @obj@\/@value@ pair so that
-- `Data.GI.Base.Constructible.new` works on values of type @value@.
type AttrConstructC info obj attr value = (HasAttributeList obj,
                                           info ~ ResolveAttribute attr obj,
                                           AttrInfo info,
                                           AttrBaseTypeConstraint info obj,
                                           AttrOpAllowed 'AttrConstruct info obj,
                                           (AttrSetTypeConstraint info) value)

-- | Constructors for the different operations allowed on an attribute.
data AttrOp obj (tag :: AttrOpTag) where
    -- | Assign a value to an attribute
    (:=)  :: (HasAttributeList obj,
              info ~ ResolveAttribute attr obj,
              AttrInfo info,
              AttrBaseTypeConstraint info obj,
              AttrOpAllowed tag info obj,
              (AttrSetTypeConstraint info) b) =>
             AttrLabelProxy (attr :: Symbol) -> b -> AttrOp obj tag
    -- | Assign the result of an IO action to an attribute
    (:=>) :: (HasAttributeList obj,
              info ~ ResolveAttribute attr obj,
              AttrInfo info,
              AttrBaseTypeConstraint info obj,
              AttrOpAllowed tag info obj,
              (AttrSetTypeConstraint info) b) =>
             AttrLabelProxy (attr :: Symbol) -> IO b -> AttrOp obj tag
    -- | Apply an update function to an attribute
    (:~)  :: (HasAttributeList obj,
              info ~ ResolveAttribute attr obj,
              AttrInfo info,
              AttrBaseTypeConstraint info obj,
              tag ~ 'AttrSet,
              AttrOpAllowed 'AttrSet info obj,
              AttrOpAllowed 'AttrGet info obj,
              (AttrSetTypeConstraint info) b,
              a ~ (AttrGetType info)) =>
             AttrLabelProxy (attr :: Symbol) -> (a -> b) -> AttrOp obj tag
    -- | Apply an IO update function to an attribute
    (:~>) :: (HasAttributeList obj,
              info ~ ResolveAttribute attr obj,
              AttrInfo info,
              AttrBaseTypeConstraint info obj,
              tag ~ 'AttrSet,
              AttrOpAllowed 'AttrSet info obj,
              AttrOpAllowed 'AttrGet info obj,
              (AttrSetTypeConstraint info) b,
              a ~ (AttrGetType info)) =>
             AttrLabelProxy (attr :: Symbol) -> (a -> IO b) -> AttrOp obj tag
    -- | Assign a value to an attribute, allocating any necessary
    -- memory for representing the Haskell value as a C value. Note
    -- that it is the responsibility of the caller to make sure that
    -- the memory is freed when no longer used, otherwise there will
    -- be a memory leak. In the majority of cases you probably want to
    -- use ':=' instead, which has no potential memory leaks (at the
    -- cost of sometimes requiring some explicit Haskell -> C
    -- marshalling).
    (:&=) :: (HasAttributeList obj,
              info ~ ResolveAttribute attr obj,
              AttrInfo info,
              AttrBaseTypeConstraint info obj,
              AttrOpAllowed tag info obj,
              (AttrTransferTypeConstraint info) b,
              AttrSetTypeConstraint info (AttrTransferType info)) =>
             AttrLabelProxy (attr :: Symbol) -> b -> AttrOp obj tag
    -- | Bind a property to the given `DynVal`, so that the property
    -- is changed whenever the `DynVal` is. This requires the implicit
    -- param @?_haskell_gi_modelProxy@, of type @`ModelProxy` model@ to be set.
    (:!<~) :: (HasAttributeList obj,
              info ~ ResolveAttribute attr obj,
              AttrInfo info,
              AttrBaseTypeConstraint info obj,
              AttrOpAllowed tag info obj,
              (AttrSetTypeConstraint info) b,
              ?_haskell_gi_modelProxy :: ModelProxy model
             ) =>
             AttrLabelProxy (attr :: Symbol) -> DynVal model b -> AttrOp obj ta
    -- | Bind a property to the given `DynVal`, so that the property
    -- is changed whenever the `DynVal` is. This requires the implicit
    -- param @?_haskell_gi_modelProxy@, of type @`ModelProxy` model@
    -- to be set. This will only actually set the property whenever
    -- the `DynVal` changes if the new value of the `DynVal` is
    -- different from the actual value of the property. If you want to
    -- set the property without checking equality you can use `:!<~`
    -- instead.
    (:<~) :: (HasAttributeList obj,
              info ~ ResolveAttribute attr obj,
              AttrInfo info,
              AttrBaseTypeConstraint info obj,
              AttrOpAllowed tag info obj,
              (AttrSetTypeConstraint info) b,
              AttrOpAllowed 'AttrGet info obj,
              EqMaybe b (AttrGetType info),
              ?_haskell_gi_modelProxy :: ModelProxy model
             ) =>
             AttrLabelProxy (attr :: Symbol) -> DynVal model b -> AttrOp obj tag
    -- | Given an AttrLabelProxy, bind the given attribute to the
    -- corresponding field in the model proxy (if there's one), so
    -- that changes in the attribute are reflected back into changes
    -- of the model.
    Bind :: (HasAttributeList obj,
             GObject obj,
             info ~ ResolveAttribute propName obj,
             AttrInfo info,
             KnownSymbol (AttrLabel info),
             AttrBaseTypeConstraint info obj,
             AttrOpAllowed tag info obj,
             AttrOpAllowed 'AttrPut info obj,
             ?_haskell_gi_modelProxy :: ModelProxy model,
             outType ~ AttrGetType info,
             (AttrSetTypeConstraint info) outType,
             components ~ Components fieldName,
             PathFieldAccess components model outType,
             KnownSymbol fieldName,
             Eq outType
            ) =>
            AttrLabelProxy (propName :: Symbol) ->
            AttrLabelProxy (fieldName :: Symbol) ->
            AttrOp obj tag

    -- | Connect the given signal to a signal handler.
    On    :: (GObject obj, SignalInfo info) =>
             SignalProxy obj info
          -> ((?self :: obj) => HaskellCallbackType info)
          -> AttrOp obj tag
    -- | Like 'On', but connect after the default signal.
    After :: (GObject obj, SignalInfo info) =>
             SignalProxy obj info
          -> ((?self :: obj) => HaskellCallbackType info)
          -> AttrOp obj tag

class EqMaybe a b where
  eqMaybe :: a -> b -> Bool

instance Eq a => EqMaybe a a where
  eqMaybe :: a -> a -> Bool
eqMaybe a
x a
y = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y

instance Eq a => EqMaybe a (Maybe a) where
  eqMaybe :: a -> Maybe a -> Bool
eqMaybe a
_ Maybe a
Nothing = Bool
False
  eqMaybe a
x (Just a
y) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y

-- | Set a number of properties for some object.
set :: forall o m. MonadIO m => o -> [AttrOp o 'AttrSet] -> m ()
set :: forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
set o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ([AttrOp o 'AttrSet] -> IO ()) -> [AttrOp o 'AttrSet] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrOp o 'AttrSet -> IO ()) -> [AttrOp o 'AttrSet] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AttrOp o 'AttrSet -> IO ()
app
 where
   app :: AttrOp o 'AttrSet -> IO ()
   app :: AttrOp o 'AttrSet -> IO ()
app ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :=  b
x) =
     forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj b
x

   app ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :=> IO b
x) =
     IO b
x IO b -> (b -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj

   app ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :~  a -> b
f) =
     forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @(ResolveAttribute label o) o
obj IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     \a
v -> forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj (a -> b
f a
v)

   app ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :~> a -> IO b
f) =
     forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @(ResolveAttribute label o) o
obj IO a -> (a -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO b
f IO b -> (b -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj

   app ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :&= b
x) =
     forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrTransferTypeConstraint info b) =>
Proxy o -> b -> IO (AttrTransferType info)
attrTransfer @(ResolveAttribute label o) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @o) b
x IO (AttrTransferType info)
-> (AttrTransferType info -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj

   app ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :!<~ DynVal model b
dv) = do
     model
model <- ModelProxy model -> IO model
forall model. ModelProxy model -> IO model
modelProxyCurrentValue ?_haskell_gi_modelProxy::ModelProxy model
ModelProxy model
?_haskell_gi_modelProxy
     forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj (DynVal model b -> model -> b
forall model a. DynVal model a -> model -> a
dvRead DynVal model b
dv model
model)
     ModelProxy model -> DVKey -> (model -> IO ()) -> IO ()
forall model.
ModelProxy model -> DVKey -> (model -> IO ()) -> IO ()
modelProxyRegisterHandler ?_haskell_gi_modelProxy::ModelProxy model
ModelProxy model
?_haskell_gi_modelProxy (DynVal model b -> DVKey
forall model a. DynVal model a -> DVKey
dvKeys DynVal model b
dv) ((model -> IO ()) -> IO ()) -> (model -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \model
modifiedModel ->
       forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj (DynVal model b -> model -> b
forall model a. DynVal model a -> model -> a
dvRead DynVal model b
dv model
modifiedModel)

   app ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :<~ DynVal model b
dv) = do
     model
model <- ModelProxy model -> IO model
forall model. ModelProxy model -> IO model
modelProxyCurrentValue ?_haskell_gi_modelProxy::ModelProxy model
ModelProxy model
?_haskell_gi_modelProxy
     AttrGetType info
currentValue <- forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @(ResolveAttribute label o) o
obj
     let newValue :: b
newValue = DynVal model b -> model -> b
forall model a. DynVal model a -> model -> a
dvRead DynVal model b
dv model
model
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ b
newValue b -> AttrGetType info -> Bool
forall a b. EqMaybe a b => a -> b -> Bool
`eqMaybe` AttrGetType info
currentValue) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
       forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj b
newValue
     ModelProxy model -> DVKey -> (model -> IO ()) -> IO ()
forall model.
ModelProxy model -> DVKey -> (model -> IO ()) -> IO ()
modelProxyRegisterHandler ?_haskell_gi_modelProxy::ModelProxy model
ModelProxy model
?_haskell_gi_modelProxy (DynVal model b -> DVKey
forall model a. DynVal model a -> DVKey
dvKeys DynVal model b
dv) ((model -> IO ()) -> IO ()) -> (model -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \model
modifiedModel -> do
       AttrGetType info
current <- forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @(ResolveAttribute label o) o
obj
       let modifiedValue :: b
modifiedValue = DynVal model b -> model -> b
forall model a. DynVal model a -> model -> a
dvRead DynVal model b
dv model
modifiedModel
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ b
modifiedValue b -> AttrGetType info -> Bool
forall a b. EqMaybe a b => a -> b -> Bool
`eqMaybe` AttrGetType info
current) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
 AttrSetTypeConstraint info b) =>
o -> b -> IO ()
attrSet @(ResolveAttribute label o) o
obj b
modifiedValue

   app (Bind AttrLabelProxy propName
pattr AttrLabelProxy fieldName
fattr) = Proxy 'AttrSet
-> o
-> AttrLabelProxy propName
-> AttrLabelProxy fieldName
-> IO ()
forall o info (prop :: Symbol) (field :: Symbol) model outType
       (tag :: AttrOpTag) (components :: [Symbol]).
(HasAttributeList o, GObject o, info ~ ResolveAttribute prop o,
 AttrInfo info, KnownSymbol (AttrLabel info),
 AttrBaseTypeConstraint info o, AttrOpAllowed tag info o,
 AttrOpAllowed 'AttrPut info o,
 ?_haskell_gi_modelProxy::ModelProxy model,
 outType ~ AttrGetType info, AttrSetTypeConstraint info outType,
 components ~ Components field,
 PathFieldAccess components model outType, KnownSymbol field,
 Eq outType) =>
Proxy tag
-> o -> AttrLabelProxy prop -> AttrLabelProxy field -> IO ()
bindPropToField (forall {k} (t :: k). Proxy t
forall (t :: AttrOpTag). Proxy t
Proxy @'AttrSet) o
obj AttrLabelProxy propName
pattr AttrLabelProxy fieldName
fattr

   app (On SignalProxy o info
signal (?self::o) => HaskellCallbackType info
callback) = IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ o
-> SignalProxy o info
-> ((?self::o) => HaskellCallbackType info)
-> IO SignalHandlerId
forall object info (m :: * -> *).
(GObject object, MonadIO m, SignalInfo info) =>
object
-> SignalProxy object info
-> ((?self::object) => HaskellCallbackType info)
-> m SignalHandlerId
on o
obj SignalProxy o info
signal HaskellCallbackType info
(?self::o) => HaskellCallbackType info
callback
   app (After SignalProxy o info
signal (?self::o) => HaskellCallbackType info
callback) = IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ o
-> SignalProxy o info
-> ((?self::o) => HaskellCallbackType info)
-> IO SignalHandlerId
forall object info (m :: * -> *).
(GObject object, MonadIO m, SignalInfo info) =>
object
-> SignalProxy object info
-> ((?self::object) => HaskellCallbackType info)
-> m SignalHandlerId
after o
obj SignalProxy o info
signal HaskellCallbackType info
(?self::o) => HaskellCallbackType info
callback

-- | Constraints on a @obj@\/@attr@ pair so `get` is possible,
-- producing a value of type @result@.
type AttrGetC info obj attr result = (HasAttributeList obj,
                                      info ~ ResolveAttribute attr obj,
                                      AttrInfo info,
                                      (AttrBaseTypeConstraint info) obj,
                                      AttrOpAllowed 'AttrGet info obj,
                                      result ~ AttrGetType info)

-- | Get the value of an attribute for an object.
get :: forall info attr obj result m.
       (AttrGetC info obj attr result, MonadIO m) =>
        obj -> AttrLabelProxy (attr :: Symbol) -> m result
get :: forall info (attr :: Symbol) obj result (m :: * -> *).
(AttrGetC info obj attr result, MonadIO m) =>
obj -> AttrLabelProxy attr -> m result
get obj
o AttrLabelProxy attr
_ = IO (AttrGetType info) -> m (AttrGetType info)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AttrGetType info) -> m (AttrGetType info))
-> IO (AttrGetType info) -> m (AttrGetType info)
forall a b. (a -> b) -> a -> b
$ forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @info obj
o

-- | Constraint on a @obj@\/@attr@ pair so that `clear` is allowed.
type AttrClearC info obj attr = (HasAttributeList obj,
                                 info ~ ResolveAttribute attr obj,
                                 AttrInfo info,
                                 (AttrBaseTypeConstraint info) obj,
                                 AttrOpAllowed 'AttrClear info obj)

-- | Set a nullable attribute to @NULL@.
clear :: forall info attr obj m.
         (AttrClearC info obj attr, MonadIO m) =>
         obj -> AttrLabelProxy (attr :: Symbol) -> m ()
clear :: forall info (attr :: Symbol) obj (m :: * -> *).
(AttrClearC info obj attr, MonadIO m) =>
obj -> AttrLabelProxy attr -> m ()
clear obj
o AttrLabelProxy attr
_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO ()
attrClear @info obj
o

-- | Return the fully qualified attribute name that a given overloaded
-- attribute resolves to (mostly useful for debugging).
--
-- > resolveAttr #sensitive button
resolveAttr :: forall info attr obj.
               (HasAttributeList obj, info ~ ResolveAttribute attr obj,
                 AttrInfo info) =>
               obj -> AttrLabelProxy (attr :: Symbol) -> Maybe ResolvedSymbolInfo
resolveAttr :: forall info (attr :: Symbol) obj.
(HasAttributeList obj, info ~ ResolveAttribute attr obj,
 AttrInfo info) =>
obj -> AttrLabelProxy attr -> Maybe ResolvedSymbolInfo
resolveAttr obj
_o AttrLabelProxy attr
_p = forall info. AttrInfo info => Maybe ResolvedSymbolInfo
dbgAttrInfo @info

-- | Create a binding between the given property of an object and a
-- field in the model.
bindPropToField :: forall o info prop field model outType tag components.
                   (HasAttributeList o,
                    GObject o,
                    info ~ ResolveAttribute prop o,
                    AttrInfo info,
                    KnownSymbol (AttrLabel info),
                    AttrBaseTypeConstraint info o,
                    AttrOpAllowed tag info o,
                    AttrOpAllowed 'AttrPut info o,
                    ?_haskell_gi_modelProxy :: ModelProxy model,
                    outType ~ AttrGetType info,
                    (AttrSetTypeConstraint info) outType,
                    components ~ Components field,
                    PathFieldAccess components model outType,
                    KnownSymbol field,
                    Eq outType
                   ) =>
                   Proxy tag -> o -> AttrLabelProxy (prop :: Symbol) ->
                   AttrLabelProxy (field :: Symbol) -> IO ()
bindPropToField :: forall o info (prop :: Symbol) (field :: Symbol) model outType
       (tag :: AttrOpTag) (components :: [Symbol]).
(HasAttributeList o, GObject o, info ~ ResolveAttribute prop o,
 AttrInfo info, KnownSymbol (AttrLabel info),
 AttrBaseTypeConstraint info o, AttrOpAllowed tag info o,
 AttrOpAllowed 'AttrPut info o,
 ?_haskell_gi_modelProxy::ModelProxy model,
 outType ~ AttrGetType info, AttrSetTypeConstraint info outType,
 components ~ Components field,
 PathFieldAccess components model outType, KnownSymbol field,
 Eq outType) =>
Proxy tag
-> o -> AttrLabelProxy prop -> AttrLabelProxy field -> IO ()
bindPropToField Proxy tag
_ o
obj AttrLabelProxy prop
_ AttrLabelProxy field
_ = do
  model
model <- ModelProxy model -> IO model
forall model. ModelProxy model -> IO model
modelProxyCurrentValue ?_haskell_gi_modelProxy::ModelProxy model
ModelProxy model
?_haskell_gi_modelProxy

  -- Set the property to the current value in the model.
  outType
currentPropValue <- forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @(ResolveAttribute prop o) o
obj
  let (Lens' model outType
lens, [Text]
components) = Proxy components -> Proxy model -> (Lens' model outType, [Text])
forall (path :: [Symbol]) model val.
PathFieldAccess path model val =>
Proxy path -> Proxy model -> (Lens' model val, [Text])
pathFieldAccess (forall (t :: [Symbol]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @components)
                                           (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @model)
      key :: DVKey
key = [Text] -> DVKey
DVKeyDirect [Text]
components
      currentModelValue :: outType
currentModelValue = Lens' model outType -> model -> outType
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
O.view Lens' model outType
lens model
model
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (outType
currentModelValue outType -> outType -> Bool
forall a. Eq a => a -> a -> Bool
/= outType
currentPropValue) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> AttrGetType info -> IO ()
attrPut @(ResolveAttribute prop o) o
obj outType
AttrGetType (ResolveAttribute prop o)
currentModelValue

  -- Set the property whenever the model changes.
  ModelProxy model -> DVKey -> (model -> IO ()) -> IO ()
forall model.
ModelProxy model -> DVKey -> (model -> IO ()) -> IO ()
modelProxyRegisterHandler ?_haskell_gi_modelProxy::ModelProxy model
ModelProxy model
?_haskell_gi_modelProxy DVKey
key ((model -> IO ()) -> IO ()) -> (model -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \model
modifiedModel -> do
    let newVal :: outType
newVal = Lens' model outType -> model -> outType
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
O.view Lens' model outType
lens model
modifiedModel
    outType
oldVal <- forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @(ResolveAttribute prop o) o
obj
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (outType
newVal outType -> outType -> Bool
forall a. Eq a => a -> a -> Bool
/= outType
oldVal) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> AttrGetType info -> IO ()
attrPut @(ResolveAttribute prop o) o
obj outType
AttrGetType (ResolveAttribute prop o)
newVal

  -- Change the model whenever the property changes.
  let handler :: o -> GParamSpec -> IO ()
handler = \o
_parent GParamSpec
_psec -> do
        outType
newVal <- forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @(ResolveAttribute prop o) o
obj
        let doUpdate :: model -> Maybe model
doUpdate model
curModel =
              let oldVal :: outType
oldVal = Lens' model outType -> model -> outType
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
O.view Lens' model outType
lens model
curModel
              in if outType
newVal outType -> outType -> Bool
forall a. Eq a => a -> a -> Bool
== outType
oldVal
                then Maybe model
forall a. Maybe a
Nothing
                else model -> Maybe model
forall a. a -> Maybe a
Just (model -> Maybe model) -> model -> Maybe model
forall a b. (a -> b) -> a -> b
$ Lens' model outType -> outType -> model -> model
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
O.set Lens' model outType
lens outType
newVal model
curModel
        ModelProxy model -> [Text] -> (model -> Maybe model) -> IO ()
forall model.
ModelProxy model -> [Text] -> (model -> Maybe model) -> IO ()
modelProxyUpdate ?_haskell_gi_modelProxy::ModelProxy model
ModelProxy model
?_haskell_gi_modelProxy [Text]
components model -> Maybe model
doUpdate
      propName :: Text
propName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy (AttrLabel info) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(AttrLabel (ResolveAttribute prop o)))

  IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ o
-> (o -> GParamSpec -> IO ())
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o.
GObject o =>
o
-> (o -> GParamSpec -> IO ())
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectGObjectNotify o
obj o -> GParamSpec -> IO ()
handler SignalConnectMode
SignalConnectBefore (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
propName)