{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.MapListModel.MapListModel' is a list model that takes a list model and maps the items
-- in that model to different items according to a t'GI.Gtk.Callbacks.MapListModelMapFunc'.
-- 
-- FIXME: Add useful examples here, like turning t'GI.Gio.Interfaces.File.File' into t'GI.Gio.Objects.FileInfo.FileInfo' or @/GdkPixmap/@.
-- 
-- t'GI.Gtk.Objects.MapListModel.MapListModel' 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                          ,
    noMapListModel                          ,


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

#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 t'GType' for elements of this object

#if defined(ENABLE_OVERLOADING)
    MapListModelItemTypePropertyInfo        ,
#endif
    constructMapListModelItemType           ,
    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




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.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 (ManagedPtr MapListModel)
    deriving (MapListModel -> MapListModel -> Bool
(MapListModel -> MapListModel -> Bool)
-> (MapListModel -> MapListModel -> Bool) -> Eq MapListModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapListModel -> MapListModel -> Bool
$c/= :: MapListModel -> MapListModel -> Bool
== :: MapListModel -> MapListModel -> Bool
$c== :: MapListModel -> MapListModel -> Bool
Eq)
foreign import ccall "gtk_map_list_model_get_type"
    c_gtk_map_list_model_get_type :: IO GType

instance GObject MapListModel where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_map_list_model_get_type
    

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

-- | Type class for types which can be safely cast to `MapListModel`, for instance with `toMapListModel`.
class (GObject o, O.IsDescendantOf MapListModel o) => IsMapListModel o
instance (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 :: (MonadIO m, IsMapListModel o) => o -> m MapListModel
toMapListModel :: o -> m MapListModel
toMapListModel = IO MapListModel -> m MapListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr MapListModel -> MapListModel
MapListModel

-- | A convenience alias for `Nothing` :: `Maybe` `MapListModel`.
noMapListModel :: Maybe MapListModel
noMapListModel :: Maybe MapListModel
noMapListModel = Maybe MapListModel
forall a. Maybe a
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.MethodInfo 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

#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 :: o -> m Bool
getMapListModelHasMap obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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
#endif

-- VVV Prop "item-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- 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 :: o -> m GType
getMapListModelItemType obj :: o
obj = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO GType
forall a. GObject a => a -> String -> IO GType
B.Properties.getObjectPropertyGType o
obj "item-type"

-- | Construct a `GValueConstruct` with valid value for the “@item-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructMapListModelItemType :: (IsMapListModel o) => GType -> IO (GValueConstruct o)
constructMapListModelItemType :: GType -> IO (GValueConstruct o)
constructMapListModelItemType val :: GType
val = String -> GType -> IO (GValueConstruct o)
forall o. String -> GType -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyGType "item-type" GType
val

#if defined(ENABLE_OVERLOADING)
data MapListModelItemTypePropertyInfo
instance AttrInfo MapListModelItemTypePropertyInfo where
    type AttrAllowedOps MapListModelItemTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint MapListModelItemTypePropertyInfo = IsMapListModel
    type AttrSetTypeConstraint MapListModelItemTypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint MapListModelItemTypePropertyInfo = (~) GType
    type AttrTransferType MapListModelItemTypePropertyInfo = GType
    type AttrGetType MapListModelItemTypePropertyInfo = GType
    type AttrLabel MapListModelItemTypePropertyInfo = "item-type"
    type AttrOrigin MapListModelItemTypePropertyInfo = MapListModel
    attrGet = getMapListModelItemType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructMapListModelItemType
    attrClear = undefined
#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 :: o -> m (Maybe ListModel)
getMapListModelModel obj :: o
obj = IO (Maybe ListModel) -> m (Maybe ListModel)
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
$ 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 "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, Gio.ListModel.IsListModel a) => a -> IO (GValueConstruct o)
constructMapListModelModel :: a -> IO (GValueConstruct o)
constructMapListModelModel val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "model" (a -> Maybe a
forall a. a -> Maybe a
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
#endif

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

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

mapListModelModel :: AttrLabelProxy "model"
mapListModelModel = 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 = "item_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType to use as the model's item type"
--                 , 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 map or %NULL for none"
--                 , 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 or %NULL to not map items"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data 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 :: 
    CGType ->                               -- item_type : TBasicType TGType
    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 t'GI.Gtk.Objects.MapListModel.MapListModel' for the given arguments.
mapListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    GType
    -- ^ /@itemType@/: the t'GType' to use as the model\'s item type
    -> Maybe (a)
    -- ^ /@model@/: The model to map or 'P.Nothing' for none
    -> Maybe (Gtk.Callbacks.MapListModelMapFunc)
    -- ^ /@mapFunc@/: map function or 'P.Nothing' to not map items
    -> m MapListModel
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.MapListModel.MapListModel'
mapListModelNew :: GType -> Maybe a -> Maybe MapListModelMapFunc -> m MapListModel
mapListModelNew itemType :: GType
itemType model :: Maybe a
model mapFunc :: Maybe MapListModelMapFunc
mapFunc = IO MapListModel -> m MapListModel
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
    let itemType' :: CGType
itemType' = GType -> CGType
gtypeToCGType GType
itemType
    Ptr ListModel
maybeModel <- case Maybe a
model of
        Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just jModel :: a
jModel -> do
            Ptr ListModel
jModel' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jModel
            Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
jModel'
    FunPtr C_MapListModelMapFunc
maybeMapFunc <- case Maybe MapListModelMapFunc
mapFunc of
        Nothing -> FunPtr C_MapListModelMapFunc -> IO (FunPtr C_MapListModelMapFunc)
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 jMapFunc :: 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 (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 ())
safeFreeFunPtrPtr
    Ptr MapListModel
result <- CGType
-> Ptr ListModel
-> FunPtr C_MapListModelMapFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO (Ptr MapListModel)
gtk_map_list_model_new CGType
itemType' 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 "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 (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 curently being mapped or 'P.Nothing' if none.
mapListModelGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsMapListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.MapListModel.MapListModel'
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model that gets mapped
mapListModelGetModel :: a -> m (Maybe ListModel)
mapListModelGetModel self :: a
self = IO (Maybe ListModel) -> m (Maybe ListModel)
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
$ \result' :: 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 (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 (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.MethodInfo MapListModelGetModelMethodInfo a signature where
    overloadedMethod = 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 t'GI.Gtk.Objects.MapListModel.MapListModel'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a map function is set
mapListModelHasMap :: a -> m Bool
mapListModelHasMap self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MapListModelHasMapMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMapListModel a) => O.MethodInfo MapListModelHasMapMethodInfo a signature where
    overloadedMethod = 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 or %NULL to not map items"
--                 , 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 t'GI.Gtk.Objects.MapListModel.MapListModel' 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 t'GI.Gtk.Objects.MapListModel.MapListModel'
    -> Maybe (Gtk.Callbacks.MapListModelMapFunc)
    -- ^ /@mapFunc@/: map function or 'P.Nothing' to not map items
    -> m ()
mapListModelSetMapFunc :: a -> Maybe MapListModelMapFunc -> m ()
mapListModelSetMapFunc self :: a
self mapFunc :: Maybe MapListModelMapFunc
mapFunc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Nothing -> FunPtr C_MapListModelMapFunc -> IO (FunPtr C_MapListModelMapFunc)
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 jMapFunc :: 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 (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 ())
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 (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.MethodInfo MapListModelSetMapFuncMethodInfo a signature where
    overloadedMethod = 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 t'GI.Gtk.Objects.MapListModel.MapListModel'
    -> Maybe (b)
    -- ^ /@model@/: The model to be mapped
    -> m ()
mapListModelSetModel :: a -> Maybe b -> m ()
mapListModelSetModel self :: a
self model :: Maybe b
model = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
nullPtr
        Just jModel :: 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 (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 (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.MethodInfo MapListModelSetModelMethodInfo a signature where
    overloadedMethod = mapListModelSetModel

#endif