{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GtkMapListModel@ maps the items in a list model to different items.
-- 
-- @GtkMapListModel@ uses a [callback/@gtk@/.MapListModelMapFunc].
-- 
-- Example: Create a list of @GtkEventControllers@
-- 
-- === /c code/
-- >static gpointer
-- >map_to_controllers (gpointer widget,
-- >                    gpointer data)
-- >{
-- >  gpointer result = gtk_widget_observe_controllers (widget);
-- >  g_object_unref (widget);
-- >  return result;
-- >}
-- >
-- >widgets = gtk_widget_observe_children (widget);
-- >
-- >controllers = gtk_map_list_model_new (widgets,
-- >                                      map_to_controllers,
-- >                                      NULL, NULL);
-- >
-- >model = gtk_flatten_list_model_new (GTK_TYPE_EVENT_CONTROLLER,
-- >                                    controllers);
-- 
-- 
-- @GtkMapListModel@ will attempt to discard the mapped objects as soon as
-- they are no longer needed and recreate them if necessary.

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

module GI.Gtk.Objects.MapListModel
    ( 

-- * Exported types
    MapListModel(..)                        ,
    IsMapListModel                          ,
    toMapListModel                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasMap]("GI.Gtk.Objects.MapListModel#g:method:hasMap"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [itemsChanged]("GI.Gio.Interfaces.ListModel#g:method:itemsChanged"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getModel]("GI.Gtk.Objects.MapListModel#g:method:getModel"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setMapFunc]("GI.Gtk.Objects.MapListModel#g:method:setMapFunc"), [setModel]("GI.Gtk.Objects.MapListModel#g:method:setModel"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveMapListModelMethod               ,
#endif

-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    MapListModelGetModelMethodInfo          ,
#endif
    mapListModelGetModel                    ,


-- ** hasMap #method:hasMap#

#if defined(ENABLE_OVERLOADING)
    MapListModelHasMapMethodInfo            ,
#endif
    mapListModelHasMap                      ,


-- ** new #method:new#

    mapListModelNew                         ,


-- ** setMapFunc #method:setMapFunc#

#if defined(ENABLE_OVERLOADING)
    MapListModelSetMapFuncMethodInfo        ,
#endif
    mapListModelSetMapFunc                  ,


-- ** setModel #method:setModel#

#if defined(ENABLE_OVERLOADING)
    MapListModelSetModelMethodInfo          ,
#endif
    mapListModelSetModel                    ,




 -- * Properties


-- ** hasMap #attr:hasMap#
-- | If a map is set for this model

#if defined(ENABLE_OVERLOADING)
    MapListModelHasMapPropertyInfo          ,
#endif
    getMapListModelHasMap                   ,


-- ** itemType #attr:itemType#
-- | The type of items. See 'GI.Gio.Interfaces.ListModel.listModelGetItemType'.
-- 
-- /Since: 4.8/

#if defined(ENABLE_OVERLOADING)
    MapListModelItemTypePropertyInfo        ,
#endif
    getMapListModelItemType                 ,
#if defined(ENABLE_OVERLOADING)
    mapListModelItemType                    ,
#endif


-- ** model #attr:model#
-- | The model being mapped.

#if defined(ENABLE_OVERLOADING)
    MapListModelModelPropertyInfo           ,
#endif
    constructMapListModelModel              ,
    getMapListModelModel                    ,
#if defined(ENABLE_OVERLOADING)
    mapListModelModel                       ,
#endif


-- ** nItems #attr:nItems#
-- | The number of items. See 'GI.Gio.Interfaces.ListModel.listModelGetNItems'.
-- 
-- /Since: 4.8/

#if defined(ENABLE_OVERLOADING)
    MapListModelNItemsPropertyInfo          ,
#endif
    getMapListModelNItems                   ,
#if defined(ENABLE_OVERLOADING)
    mapListModelNItems                      ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.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.GHashTable as B.GHT
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.Coerce as Coerce
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.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gtk.Callbacks as Gtk.Callbacks

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

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

foreign import ccall "gtk_map_list_model_get_type"
    c_gtk_map_list_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject MapListModel where
    glibType :: IO GType
glibType = IO GType
c_gtk_map_list_model_get_type

instance B.Types.GObject MapListModel

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

instance O.HasParentTypes MapListModel
type instance O.ParentTypes MapListModel = '[GObject.Object.Object, Gio.ListModel.ListModel]

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

-- | Convert 'MapListModel' 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 MapListModel) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_map_list_model_get_type
    gvalueSet_ :: Ptr GValue -> Maybe MapListModel -> IO ()
gvalueSet_ Ptr GValue
gv Maybe MapListModel
P.Nothing = Ptr GValue -> Ptr MapListModel -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr MapListModel
forall a. Ptr a
FP.nullPtr :: FP.Ptr MapListModel)
    gvalueSet_ Ptr GValue
gv (P.Just MapListModel
obj) = MapListModel -> (Ptr MapListModel -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr MapListModel
obj (Ptr GValue -> Ptr MapListModel -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe MapListModel)
gvalueGet_ Ptr GValue
gv = do
        Ptr MapListModel
ptr <- Ptr GValue -> IO (Ptr MapListModel)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr MapListModel)
        if Ptr MapListModel
ptr Ptr MapListModel -> Ptr MapListModel -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr MapListModel
forall a. Ptr a
FP.nullPtr
        then MapListModel -> Maybe MapListModel
forall a. a -> Maybe a
P.Just (MapListModel -> Maybe MapListModel)
-> IO MapListModel -> IO (Maybe MapListModel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr MapListModel -> MapListModel)
-> Ptr MapListModel -> IO MapListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr MapListModel -> MapListModel
MapListModel Ptr MapListModel
ptr
        else Maybe MapListModel -> IO (Maybe MapListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MapListModel
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveMapListModelMethod (t :: Symbol) (o :: *) :: * where
    ResolveMapListModelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMapListModelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMapListModelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMapListModelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMapListModelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMapListModelMethod "hasMap" o = MapListModelHasMapMethodInfo
    ResolveMapListModelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMapListModelMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveMapListModelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMapListModelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMapListModelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMapListModelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMapListModelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMapListModelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMapListModelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMapListModelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMapListModelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMapListModelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMapListModelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMapListModelMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveMapListModelMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveMapListModelMethod "getModel" o = MapListModelGetModelMethodInfo
    ResolveMapListModelMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveMapListModelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMapListModelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMapListModelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMapListModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMapListModelMethod "setMapFunc" o = MapListModelSetMapFuncMethodInfo
    ResolveMapListModelMethod "setModel" o = MapListModelSetModelMethodInfo
    ResolveMapListModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMapListModelMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMapListModelMethod t MapListModel, O.OverloadedMethod info MapListModel p) => OL.IsLabel t (MapListModel -> 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 ~ ResolveMapListModelMethod t MapListModel, O.OverloadedMethod info MapListModel p, R.HasField t MapListModel p) => R.HasField t MapListModel p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- VVV Prop "has-map"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@has-map@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mapListModel #hasMap
-- @
getMapListModelHasMap :: (MonadIO m, IsMapListModel o) => o -> m Bool
getMapListModelHasMap :: forall (m :: * -> *) o.
(MonadIO m, IsMapListModel o) =>
o -> m Bool
getMapListModelHasMap o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"has-map"

#if defined(ENABLE_OVERLOADING)
data MapListModelHasMapPropertyInfo
instance AttrInfo MapListModelHasMapPropertyInfo where
    type AttrAllowedOps MapListModelHasMapPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MapListModelHasMapPropertyInfo = IsMapListModel
    type AttrSetTypeConstraint MapListModelHasMapPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MapListModelHasMapPropertyInfo = (~) ()
    type AttrTransferType MapListModelHasMapPropertyInfo = ()
    type AttrGetType MapListModelHasMapPropertyInfo = Bool
    type AttrLabel MapListModelHasMapPropertyInfo = "has-map"
    type AttrOrigin MapListModelHasMapPropertyInfo = MapListModel
    attrGet = getMapListModelHasMap
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.MapListModel.hasMap"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-MapListModel.html#g:attr:hasMap"
        })
#endif

-- VVV Prop "item-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@item-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mapListModel #itemType
-- @
getMapListModelItemType :: (MonadIO m, IsMapListModel o) => o -> m GType
getMapListModelItemType :: forall (m :: * -> *) o.
(MonadIO m, IsMapListModel o) =>
o -> m GType
getMapListModelItemType o
obj = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO GType
forall a. GObject a => a -> String -> IO GType
B.Properties.getObjectPropertyGType o
obj String
"item-type"

#if defined(ENABLE_OVERLOADING)
data MapListModelItemTypePropertyInfo
instance AttrInfo MapListModelItemTypePropertyInfo where
    type AttrAllowedOps MapListModelItemTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MapListModelItemTypePropertyInfo = IsMapListModel
    type AttrSetTypeConstraint MapListModelItemTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint MapListModelItemTypePropertyInfo = (~) ()
    type AttrTransferType MapListModelItemTypePropertyInfo = ()
    type AttrGetType MapListModelItemTypePropertyInfo = GType
    type AttrLabel MapListModelItemTypePropertyInfo = "item-type"
    type AttrOrigin MapListModelItemTypePropertyInfo = MapListModel
    attrGet = getMapListModelItemType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.MapListModel.itemType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-MapListModel.html#g:attr:itemType"
        })
#endif

-- VVV Prop "model"
   -- Type: TInterface (Name {namespace = "Gio", name = "ListModel"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@model@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mapListModel #model
-- @
getMapListModelModel :: (MonadIO m, IsMapListModel o) => o -> m (Maybe Gio.ListModel.ListModel)
getMapListModelModel :: forall (m :: * -> *) o.
(MonadIO m, IsMapListModel o) =>
o -> m (Maybe ListModel)
getMapListModelModel o
obj = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ListModel -> ListModel)
-> IO (Maybe ListModel)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"model" ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel

-- | Construct a `GValueConstruct` with valid value for the “@model@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMapListModelModel :: (IsMapListModel o, MIO.MonadIO m, Gio.ListModel.IsListModel a) => a -> m (GValueConstruct o)
constructMapListModelModel :: forall o (m :: * -> *) a.
(IsMapListModel o, MonadIO m, IsListModel a) =>
a -> m (GValueConstruct o)
constructMapListModelModel a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"model" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data MapListModelModelPropertyInfo
instance AttrInfo MapListModelModelPropertyInfo where
    type AttrAllowedOps MapListModelModelPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MapListModelModelPropertyInfo = IsMapListModel
    type AttrSetTypeConstraint MapListModelModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint MapListModelModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType MapListModelModelPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType MapListModelModelPropertyInfo = (Maybe Gio.ListModel.ListModel)
    type AttrLabel MapListModelModelPropertyInfo = "model"
    type AttrOrigin MapListModelModelPropertyInfo = MapListModel
    attrGet = getMapListModelModel
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructMapListModelModel
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.MapListModel.model"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-MapListModel.html#g:attr:model"
        })
#endif

-- VVV Prop "n-items"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@n-items@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mapListModel #nItems
-- @
getMapListModelNItems :: (MonadIO m, IsMapListModel o) => o -> m Word32
getMapListModelNItems :: forall (m :: * -> *) o.
(MonadIO m, IsMapListModel o) =>
o -> m Word32
getMapListModelNItems o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"n-items"

#if defined(ENABLE_OVERLOADING)
data MapListModelNItemsPropertyInfo
instance AttrInfo MapListModelNItemsPropertyInfo where
    type AttrAllowedOps MapListModelNItemsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MapListModelNItemsPropertyInfo = IsMapListModel
    type AttrSetTypeConstraint MapListModelNItemsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MapListModelNItemsPropertyInfo = (~) ()
    type AttrTransferType MapListModelNItemsPropertyInfo = ()
    type AttrGetType MapListModelNItemsPropertyInfo = Word32
    type AttrLabel MapListModelNItemsPropertyInfo = "n-items"
    type AttrOrigin MapListModelNItemsPropertyInfo = MapListModel
    attrGet = getMapListModelNItems
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.MapListModel.nItems"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-MapListModel.html#g:attr:nItems"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MapListModel
type instance O.AttributeList MapListModel = MapListModelAttributeList
type MapListModelAttributeList = ('[ '("hasMap", MapListModelHasMapPropertyInfo), '("itemType", MapListModelItemTypePropertyInfo), '("model", MapListModelModelPropertyInfo), '("nItems", MapListModelNItemsPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
mapListModelItemType :: AttrLabelProxy "itemType"
mapListModelItemType = AttrLabelProxy

mapListModelModel :: AttrLabelProxy "model"
mapListModelModel = AttrLabelProxy

mapListModelNItems :: AttrLabelProxy "nItems"
mapListModelNItems = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList MapListModel = MapListModelSignalList
type MapListModelSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method MapListModel::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The model to map" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "map_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "MapListModelMapFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "map function" , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @map_func"
--                 , 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 notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "MapListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_map_list_model_new" gtk_map_list_model_new :: 
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    FunPtr Gtk.Callbacks.C_MapListModelMapFunc -> -- map_func : TInterface (Name {namespace = "Gtk", name = "MapListModelMapFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr MapListModel)

-- | Creates a new @GtkMapListModel@ for the given arguments.
mapListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    Maybe (a)
    -- ^ /@model@/: The model to map
    -> Maybe (Gtk.Callbacks.MapListModelMapFunc)
    -- ^ /@mapFunc@/: map function
    -> m MapListModel
    -- ^ __Returns:__ a new @GtkMapListModel@
mapListModelNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModel a) =>
Maybe a -> Maybe MapListModelMapFunc -> m MapListModel
mapListModelNew Maybe a
model Maybe MapListModelMapFunc
mapFunc = IO MapListModel -> m MapListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MapListModel -> m MapListModel)
-> IO MapListModel -> m MapListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListModel
maybeModel <- case Maybe a
model of
        Maybe a
Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just a
jModel -> do
            Ptr ListModel
jModel' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject a
jModel
            Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    FunPtr C_MapListModelMapFunc
maybeMapFunc <- case Maybe MapListModelMapFunc
mapFunc of
        Maybe MapListModelMapFunc
Nothing -> FunPtr C_MapListModelMapFunc -> IO (FunPtr C_MapListModelMapFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_MapListModelMapFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just MapListModelMapFunc
jMapFunc -> do
            FunPtr C_MapListModelMapFunc
jMapFunc' <- C_MapListModelMapFunc -> IO (FunPtr C_MapListModelMapFunc)
Gtk.Callbacks.mk_MapListModelMapFunc (Maybe (Ptr (FunPtr C_MapListModelMapFunc))
-> MapListModelMapFunc_WithClosures -> C_MapListModelMapFunc
Gtk.Callbacks.wrap_MapListModelMapFunc Maybe (Ptr (FunPtr C_MapListModelMapFunc))
forall a. Maybe a
Nothing (MapListModelMapFunc -> MapListModelMapFunc_WithClosures
Gtk.Callbacks.drop_closures_MapListModelMapFunc MapListModelMapFunc
jMapFunc))
            FunPtr C_MapListModelMapFunc -> IO (FunPtr C_MapListModelMapFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_MapListModelMapFunc
jMapFunc'
    let userData :: Ptr ()
userData = FunPtr C_MapListModelMapFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_MapListModelMapFunc
maybeMapFunc
    let userDestroy :: FunPtr (Ptr a -> IO ())
userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr MapListModel
result <- Ptr ListModel
-> FunPtr C_MapListModelMapFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO (Ptr MapListModel)
gtk_map_list_model_new Ptr ListModel
maybeModel FunPtr C_MapListModelMapFunc
maybeMapFunc Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
userDestroy
    Text -> Ptr MapListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mapListModelNew" Ptr MapListModel
result
    MapListModel
result' <- ((ManagedPtr MapListModel -> MapListModel)
-> Ptr MapListModel -> IO MapListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr MapListModel -> MapListModel
MapListModel) Ptr MapListModel
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
model a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    MapListModel -> IO MapListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MapListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_map_list_model_get_model" gtk_map_list_model_get_model :: 
    Ptr MapListModel ->                     -- self : TInterface (Name {namespace = "Gtk", name = "MapListModel"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Gets the model that is currently being mapped or 'P.Nothing' if none.
mapListModelGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsMapListModel a) =>
    a
    -- ^ /@self@/: a @GtkMapListModel@
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model that gets mapped
mapListModelGetModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMapListModel a) =>
a -> m (Maybe ListModel)
mapListModelGetModel a
self = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MapListModel
self' <- a -> IO (Ptr MapListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr MapListModel -> IO (Ptr ListModel)
gtk_map_list_model_get_model Ptr MapListModel
self'
    Maybe ListModel
maybeResult <- Ptr ListModel
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ListModel
result ((Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel))
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ \Ptr ListModel
result' -> do
        ListModel
result'' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result'
        ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
maybeResult

#if defined(ENABLE_OVERLOADING)
data MapListModelGetModelMethodInfo
instance (signature ~ (m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsMapListModel a) => O.OverloadedMethod MapListModelGetModelMethodInfo a signature where
    overloadedMethod = mapListModelGetModel

instance O.OverloadedMethodInfo MapListModelGetModelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.MapListModel.mapListModelGetModel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-MapListModel.html#v:mapListModelGetModel"
        })


#endif

-- method MapListModel::has_map
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MapListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkMapListModel`"
--                 , 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_map_list_model_has_map" gtk_map_list_model_has_map :: 
    Ptr MapListModel ->                     -- self : TInterface (Name {namespace = "Gtk", name = "MapListModel"})
    IO CInt

-- | Checks if a map function is currently set on /@self@/.
mapListModelHasMap ::
    (B.CallStack.HasCallStack, MonadIO m, IsMapListModel a) =>
    a
    -- ^ /@self@/: a @GtkMapListModel@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a map function is set
mapListModelHasMap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMapListModel a) =>
a -> m Bool
mapListModelHasMap a
self = IO Bool -> m Bool
forall a. IO a -> m a
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 MapListModel
self' <- a -> IO (Ptr MapListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr MapListModel -> IO CInt
gtk_map_list_model_has_map Ptr MapListModel
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MapListModelHasMapMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMapListModel a) => O.OverloadedMethod MapListModelHasMapMethodInfo a signature where
    overloadedMethod = mapListModelHasMap

instance O.OverloadedMethodInfo MapListModelHasMapMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.MapListModel.mapListModelHasMap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-MapListModel.html#v:mapListModelHasMap"
        })


#endif

-- method MapListModel::set_map_func
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MapListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkMapListModel`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "map_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "MapListModelMapFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "map function" , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @map_func"
--                 , 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 notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_map_list_model_set_map_func" gtk_map_list_model_set_map_func :: 
    Ptr MapListModel ->                     -- self : TInterface (Name {namespace = "Gtk", name = "MapListModel"})
    FunPtr Gtk.Callbacks.C_MapListModelMapFunc -> -- map_func : TInterface (Name {namespace = "Gtk", name = "MapListModelMapFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the function used to map items.
-- 
-- The function will be called whenever an item needs to be mapped
-- and must return the item to use for the given input item.
-- 
-- Note that @GtkMapListModel@ may call this function multiple times
-- on the same item, because it may delete items it doesn\'t need anymore.
-- 
-- GTK makes no effort to ensure that /@mapFunc@/ conforms to the item type
-- of /@self@/. It assumes that the caller knows what they are doing and the map
-- function returns items of the appropriate type.
mapListModelSetMapFunc ::
    (B.CallStack.HasCallStack, MonadIO m, IsMapListModel a) =>
    a
    -- ^ /@self@/: a @GtkMapListModel@
    -> Maybe (Gtk.Callbacks.MapListModelMapFunc)
    -- ^ /@mapFunc@/: map function
    -> m ()
mapListModelSetMapFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMapListModel a) =>
a -> Maybe MapListModelMapFunc -> m ()
mapListModelSetMapFunc a
self Maybe MapListModelMapFunc
mapFunc = 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
$ do
    Ptr MapListModel
self' <- a -> IO (Ptr MapListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    FunPtr C_MapListModelMapFunc
maybeMapFunc <- case Maybe MapListModelMapFunc
mapFunc of
        Maybe MapListModelMapFunc
Nothing -> FunPtr C_MapListModelMapFunc -> IO (FunPtr C_MapListModelMapFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_MapListModelMapFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just MapListModelMapFunc
jMapFunc -> do
            FunPtr C_MapListModelMapFunc
jMapFunc' <- C_MapListModelMapFunc -> IO (FunPtr C_MapListModelMapFunc)
Gtk.Callbacks.mk_MapListModelMapFunc (Maybe (Ptr (FunPtr C_MapListModelMapFunc))
-> MapListModelMapFunc_WithClosures -> C_MapListModelMapFunc
Gtk.Callbacks.wrap_MapListModelMapFunc Maybe (Ptr (FunPtr C_MapListModelMapFunc))
forall a. Maybe a
Nothing (MapListModelMapFunc -> MapListModelMapFunc_WithClosures
Gtk.Callbacks.drop_closures_MapListModelMapFunc MapListModelMapFunc
jMapFunc))
            FunPtr C_MapListModelMapFunc -> IO (FunPtr C_MapListModelMapFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_MapListModelMapFunc
jMapFunc'
    let userData :: Ptr ()
userData = FunPtr C_MapListModelMapFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_MapListModelMapFunc
maybeMapFunc
    let userDestroy :: FunPtr (Ptr a -> IO ())
userDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr MapListModel
-> FunPtr C_MapListModelMapFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gtk_map_list_model_set_map_func Ptr MapListModel
self' FunPtr C_MapListModelMapFunc
maybeMapFunc Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
userDestroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MapListModelSetMapFuncMethodInfo
instance (signature ~ (Maybe (Gtk.Callbacks.MapListModelMapFunc) -> m ()), MonadIO m, IsMapListModel a) => O.OverloadedMethod MapListModelSetMapFuncMethodInfo a signature where
    overloadedMethod = mapListModelSetMapFunc

instance O.OverloadedMethodInfo MapListModelSetMapFuncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.MapListModel.mapListModelSetMapFunc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-MapListModel.html#v:mapListModelSetMapFunc"
        })


#endif

-- method MapListModel::set_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "MapListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkMapListModel`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The model to be mapped"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_map_list_model_set_model" gtk_map_list_model_set_model :: 
    Ptr MapListModel ->                     -- self : TInterface (Name {namespace = "Gtk", name = "MapListModel"})
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO ()

-- | Sets the model to be mapped.
-- 
-- GTK makes no effort to ensure that /@model@/ conforms to the item type
-- expected by the map function. It assumes that the caller knows what
-- they are doing and have set up an appropriate map function.
mapListModelSetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsMapListModel a, Gio.ListModel.IsListModel b) =>
    a
    -- ^ /@self@/: a @GtkMapListModel@
    -> Maybe (b)
    -- ^ /@model@/: The model to be mapped
    -> m ()
mapListModelSetModel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMapListModel a, IsListModel b) =>
a -> Maybe b -> m ()
mapListModelSetModel a
self Maybe b
model = 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
$ do
    Ptr MapListModel
self' <- a -> IO (Ptr MapListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
maybeModel <- case Maybe b
model of
        Maybe b
Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just b
jModel -> do
            Ptr ListModel
jModel' <- b -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jModel
            Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    Ptr MapListModel -> Ptr ListModel -> IO ()
gtk_map_list_model_set_model Ptr MapListModel
self' Ptr ListModel
maybeModel
    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
model b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MapListModelSetModelMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsMapListModel a, Gio.ListModel.IsListModel b) => O.OverloadedMethod MapListModelSetModelMethodInfo a signature where
    overloadedMethod = mapListModelSetModel

instance O.OverloadedMethodInfo MapListModelSetModelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.MapListModel.mapListModelSetModel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-MapListModel.html#v:mapListModelSetModel"
        })


#endif