{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Dazzle.Objects.ReadOnlyListModel
    ( 

-- * Exported types
    ReadOnlyListModel(..)                   ,
    IsReadOnlyListModel                     ,
    toReadOnlyListModel                     ,


 -- * 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"), [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"), [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"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveReadOnlyListModelMethod          ,
#endif

-- ** new #method:new#

    readOnlyListModelNew                    ,




 -- * Properties


-- ** baseModel #attr:baseModel#
-- | The \"base-model\" property is the t'GI.Gio.Interfaces.ListModel.ListModel' that will be wrapped.
-- 
-- This base model is not accessible after creation so that API creators can
-- be sure the consumer cannot mutate the underlying model. That is useful
-- when you want to give a caller access to a t'GI.Gio.Interfaces.ListModel.ListModel' without the ability
-- to introspect on the type and mutate it without your knowledge (such as
-- with t'GI.Gio.Objects.ListStore.ListStore').
-- 
-- /Since: 3.30/

#if defined(ENABLE_OVERLOADING)
    ReadOnlyListModelBaseModelPropertyInfo  ,
#endif
    constructReadOnlyListModelBaseModel     ,
#if defined(ENABLE_OVERLOADING)
    readOnlyListModelBaseModel              ,
#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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel

#endif

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

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

foreign import ccall "dzl_read_only_list_model_get_type"
    c_dzl_read_only_list_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject ReadOnlyListModel where
    glibType :: IO GType
glibType = IO GType
c_dzl_read_only_list_model_get_type

instance B.Types.GObject ReadOnlyListModel

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

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

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

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

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

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

#endif

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

#endif

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

-- | Construct a `GValueConstruct` with valid value for the “@base-model@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructReadOnlyListModelBaseModel :: (IsReadOnlyListModel o, MIO.MonadIO m, Gio.ListModel.IsListModel a) => a -> m (GValueConstruct o)
constructReadOnlyListModelBaseModel :: forall o (m :: * -> *) a.
(IsReadOnlyListModel o, MonadIO m, IsListModel a) =>
a -> m (GValueConstruct o)
constructReadOnlyListModelBaseModel 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
"base-model" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data ReadOnlyListModelBaseModelPropertyInfo
instance AttrInfo ReadOnlyListModelBaseModelPropertyInfo where
    type AttrAllowedOps ReadOnlyListModelBaseModelPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint ReadOnlyListModelBaseModelPropertyInfo = IsReadOnlyListModel
    type AttrSetTypeConstraint ReadOnlyListModelBaseModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint ReadOnlyListModelBaseModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType ReadOnlyListModelBaseModelPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType ReadOnlyListModelBaseModelPropertyInfo = ()
    type AttrLabel ReadOnlyListModelBaseModelPropertyInfo = "base-model"
    type AttrOrigin ReadOnlyListModelBaseModelPropertyInfo = ReadOnlyListModel
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructReadOnlyListModelBaseModel
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ReadOnlyListModel.baseModel"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ReadOnlyListModel.html#g:attr:baseModel"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ReadOnlyListModel
type instance O.AttributeList ReadOnlyListModel = ReadOnlyListModelAttributeList
type ReadOnlyListModelAttributeList = ('[ '("baseModel", ReadOnlyListModelBaseModelPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
readOnlyListModelBaseModel :: AttrLabelProxy "baseModel"
readOnlyListModelBaseModel = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ReadOnlyListModel = ReadOnlyListModelSignalList
type ReadOnlyListModelSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method ReadOnlyListModel::new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "base_model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_read_only_list_model_new" dzl_read_only_list_model_new :: 
    Ptr Gio.ListModel.ListModel ->          -- base_model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Creates a new t'GI.Dazzle.Objects.ReadOnlyListModel.ReadOnlyListModel' which is a read-only wrapper around
-- /@baseModel@/. This is useful when you want to give API consumers access to
-- a t'GI.Gio.Interfaces.ListModel.ListModel' but without the ability to mutate the underlying list.
-- 
-- /Since: 3.30/
readOnlyListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    a
    -- ^ /@baseModel@/: a t'GI.Gio.Interfaces.ListModel.ListModel'
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ a t'GI.Dazzle.Objects.ReadOnlyListModel.ReadOnlyListModel'
readOnlyListModelNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModel a) =>
a -> m ListModel
readOnlyListModelNew a
baseModel = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListModel
baseModel' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
baseModel
    Ptr ListModel
result <- Ptr ListModel -> IO (Ptr ListModel)
dzl_read_only_list_model_new Ptr ListModel
baseModel'
    Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"readOnlyListModelNew" Ptr ListModel
result
    ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
baseModel
    ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif