{-# 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.SliceListModel.SliceListModel' is a list model that takes a list model and presents a slice of
-- that model.
-- 
-- This is useful when implementing paging by setting the size to the number of elements
-- per page and updating the offset whenever a different page is opened.

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

module GI.Gtk.Objects.SliceListModel
    ( 

-- * Exported types
    SliceListModel(..)                      ,
    IsSliceListModel                        ,
    toSliceListModel                        ,
    noSliceListModel                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSliceListModelMethod             ,
#endif


-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    SliceListModelGetModelMethodInfo        ,
#endif
    sliceListModelGetModel                  ,


-- ** getOffset #method:getOffset#

#if defined(ENABLE_OVERLOADING)
    SliceListModelGetOffsetMethodInfo       ,
#endif
    sliceListModelGetOffset                 ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    SliceListModelGetSizeMethodInfo         ,
#endif
    sliceListModelGetSize                   ,


-- ** new #method:new#

    sliceListModelNew                       ,


-- ** newForType #method:newForType#

    sliceListModelNewForType                ,


-- ** setModel #method:setModel#

#if defined(ENABLE_OVERLOADING)
    SliceListModelSetModelMethodInfo        ,
#endif
    sliceListModelSetModel                  ,


-- ** setOffset #method:setOffset#

#if defined(ENABLE_OVERLOADING)
    SliceListModelSetOffsetMethodInfo       ,
#endif
    sliceListModelSetOffset                 ,


-- ** setSize #method:setSize#

#if defined(ENABLE_OVERLOADING)
    SliceListModelSetSizeMethodInfo         ,
#endif
    sliceListModelSetSize                   ,




 -- * Properties
-- ** itemType #attr:itemType#
-- | The t'GType' for elements of this object

#if defined(ENABLE_OVERLOADING)
    SliceListModelItemTypePropertyInfo      ,
#endif
    constructSliceListModelItemType         ,
    getSliceListModelItemType               ,
#if defined(ENABLE_OVERLOADING)
    sliceListModelItemType                  ,
#endif


-- ** model #attr:model#
-- | Child model to take slice from

#if defined(ENABLE_OVERLOADING)
    SliceListModelModelPropertyInfo         ,
#endif
    clearSliceListModelModel                ,
    constructSliceListModelModel            ,
    getSliceListModelModel                  ,
    setSliceListModelModel                  ,
#if defined(ENABLE_OVERLOADING)
    sliceListModelModel                     ,
#endif


-- ** offset #attr:offset#
-- | Offset of slice

#if defined(ENABLE_OVERLOADING)
    SliceListModelOffsetPropertyInfo        ,
#endif
    constructSliceListModelOffset           ,
    getSliceListModelOffset                 ,
    setSliceListModelOffset                 ,
#if defined(ENABLE_OVERLOADING)
    sliceListModelOffset                    ,
#endif


-- ** size #attr:size#
-- | Maximum size of slice

#if defined(ENABLE_OVERLOADING)
    SliceListModelSizePropertyInfo          ,
#endif
    constructSliceListModelSize             ,
    getSliceListModelSize                   ,
    setSliceListModelSize                   ,
#if defined(ENABLE_OVERLOADING)
    sliceListModelSize                      ,
#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.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel

-- | Memory-managed wrapper type.
newtype SliceListModel = SliceListModel (ManagedPtr SliceListModel)
    deriving (SliceListModel -> SliceListModel -> Bool
(SliceListModel -> SliceListModel -> Bool)
-> (SliceListModel -> SliceListModel -> Bool) -> Eq SliceListModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SliceListModel -> SliceListModel -> Bool
$c/= :: SliceListModel -> SliceListModel -> Bool
== :: SliceListModel -> SliceListModel -> Bool
$c== :: SliceListModel -> SliceListModel -> Bool
Eq)
foreign import ccall "gtk_slice_list_model_get_type"
    c_gtk_slice_list_model_get_type :: IO GType

instance GObject SliceListModel where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_slice_list_model_get_type
    

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

-- | Type class for types which can be safely cast to `SliceListModel`, for instance with `toSliceListModel`.
class (GObject o, O.IsDescendantOf SliceListModel o) => IsSliceListModel o
instance (GObject o, O.IsDescendantOf SliceListModel o) => IsSliceListModel o

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

-- | Cast to `SliceListModel`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toSliceListModel :: (MonadIO m, IsSliceListModel o) => o -> m SliceListModel
toSliceListModel :: o -> m SliceListModel
toSliceListModel = IO SliceListModel -> m SliceListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SliceListModel -> m SliceListModel)
-> (o -> IO SliceListModel) -> o -> m SliceListModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SliceListModel -> SliceListModel)
-> o -> IO SliceListModel
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr SliceListModel -> SliceListModel
SliceListModel

-- | A convenience alias for `Nothing` :: `Maybe` `SliceListModel`.
noSliceListModel :: Maybe SliceListModel
noSliceListModel :: Maybe SliceListModel
noSliceListModel = Maybe SliceListModel
forall a. Maybe a
Nothing

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

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

#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' sliceListModel #itemType
-- @
getSliceListModelItemType :: (MonadIO m, IsSliceListModel o) => o -> m GType
getSliceListModelItemType :: o -> m GType
getSliceListModelItemType 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`.
constructSliceListModelItemType :: (IsSliceListModel o) => GType -> IO (GValueConstruct o)
constructSliceListModelItemType :: GType -> IO (GValueConstruct o)
constructSliceListModelItemType 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 SliceListModelItemTypePropertyInfo
instance AttrInfo SliceListModelItemTypePropertyInfo where
    type AttrAllowedOps SliceListModelItemTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SliceListModelItemTypePropertyInfo = IsSliceListModel
    type AttrSetTypeConstraint SliceListModelItemTypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint SliceListModelItemTypePropertyInfo = (~) GType
    type AttrTransferType SliceListModelItemTypePropertyInfo = GType
    type AttrGetType SliceListModelItemTypePropertyInfo = GType
    type AttrLabel SliceListModelItemTypePropertyInfo = "item-type"
    type AttrOrigin SliceListModelItemTypePropertyInfo = SliceListModel
    attrGet = getSliceListModelItemType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructSliceListModelItemType
    attrClear = undefined
#endif

-- VVV Prop "model"
   -- Type: TInterface (Name {namespace = "Gio", name = "ListModel"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- 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' sliceListModel #model
-- @
getSliceListModelModel :: (MonadIO m, IsSliceListModel o) => o -> m (Maybe Gio.ListModel.ListModel)
getSliceListModelModel :: o -> m (Maybe ListModel)
getSliceListModelModel 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

-- | Set 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.set' sliceListModel [ #model 'Data.GI.Base.Attributes.:=' value ]
-- @
setSliceListModelModel :: (MonadIO m, IsSliceListModel o, Gio.ListModel.IsListModel a) => o -> a -> m ()
setSliceListModelModel :: o -> a -> m ()
setSliceListModelModel obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "model" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | 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`.
constructSliceListModelModel :: (IsSliceListModel o, Gio.ListModel.IsListModel a) => a -> IO (GValueConstruct o)
constructSliceListModelModel :: a -> IO (GValueConstruct o)
constructSliceListModelModel 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)

-- | Set the value of the “@model@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #model
-- @
clearSliceListModelModel :: (MonadIO m, IsSliceListModel o) => o -> m ()
clearSliceListModelModel :: o -> m ()
clearSliceListModelModel obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe ListModel -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "model" (Maybe ListModel
forall a. Maybe a
Nothing :: Maybe Gio.ListModel.ListModel)

#if defined(ENABLE_OVERLOADING)
data SliceListModelModelPropertyInfo
instance AttrInfo SliceListModelModelPropertyInfo where
    type AttrAllowedOps SliceListModelModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SliceListModelModelPropertyInfo = IsSliceListModel
    type AttrSetTypeConstraint SliceListModelModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint SliceListModelModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType SliceListModelModelPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType SliceListModelModelPropertyInfo = (Maybe Gio.ListModel.ListModel)
    type AttrLabel SliceListModelModelPropertyInfo = "model"
    type AttrOrigin SliceListModelModelPropertyInfo = SliceListModel
    attrGet = getSliceListModelModel
    attrSet = setSliceListModelModel
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructSliceListModelModel
    attrClear = clearSliceListModelModel
#endif

-- VVV Prop "offset"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@offset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sliceListModel #offset
-- @
getSliceListModelOffset :: (MonadIO m, IsSliceListModel o) => o -> m Word32
getSliceListModelOffset :: o -> m Word32
getSliceListModelOffset obj :: o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "offset"

-- | Set the value of the “@offset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sliceListModel [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setSliceListModelOffset :: (MonadIO m, IsSliceListModel o) => o -> Word32 -> m ()
setSliceListModelOffset :: o -> Word32 -> m ()
setSliceListModelOffset obj :: o
obj val :: Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj "offset" Word32
val

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

#if defined(ENABLE_OVERLOADING)
data SliceListModelOffsetPropertyInfo
instance AttrInfo SliceListModelOffsetPropertyInfo where
    type AttrAllowedOps SliceListModelOffsetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SliceListModelOffsetPropertyInfo = IsSliceListModel
    type AttrSetTypeConstraint SliceListModelOffsetPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint SliceListModelOffsetPropertyInfo = (~) Word32
    type AttrTransferType SliceListModelOffsetPropertyInfo = Word32
    type AttrGetType SliceListModelOffsetPropertyInfo = Word32
    type AttrLabel SliceListModelOffsetPropertyInfo = "offset"
    type AttrOrigin SliceListModelOffsetPropertyInfo = SliceListModel
    attrGet = getSliceListModelOffset
    attrSet = setSliceListModelOffset
    attrTransfer _ v = do
        return v
    attrConstruct = constructSliceListModelOffset
    attrClear = undefined
#endif

-- VVV Prop "size"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sliceListModel #size
-- @
getSliceListModelSize :: (MonadIO m, IsSliceListModel o) => o -> m Word32
getSliceListModelSize :: o -> m Word32
getSliceListModelSize obj :: o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "size"

-- | Set the value of the “@size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sliceListModel [ #size 'Data.GI.Base.Attributes.:=' value ]
-- @
setSliceListModelSize :: (MonadIO m, IsSliceListModel o) => o -> Word32 -> m ()
setSliceListModelSize :: o -> Word32 -> m ()
setSliceListModelSize obj :: o
obj val :: Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj "size" Word32
val

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

#if defined(ENABLE_OVERLOADING)
data SliceListModelSizePropertyInfo
instance AttrInfo SliceListModelSizePropertyInfo where
    type AttrAllowedOps SliceListModelSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SliceListModelSizePropertyInfo = IsSliceListModel
    type AttrSetTypeConstraint SliceListModelSizePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint SliceListModelSizePropertyInfo = (~) Word32
    type AttrTransferType SliceListModelSizePropertyInfo = Word32
    type AttrGetType SliceListModelSizePropertyInfo = Word32
    type AttrLabel SliceListModelSizePropertyInfo = "size"
    type AttrOrigin SliceListModelSizePropertyInfo = SliceListModel
    attrGet = getSliceListModelSize
    attrSet = setSliceListModelSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructSliceListModelSize
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SliceListModel
type instance O.AttributeList SliceListModel = SliceListModelAttributeList
type SliceListModelAttributeList = ('[ '("itemType", SliceListModelItemTypePropertyInfo), '("model", SliceListModelModelPropertyInfo), '("offset", SliceListModelOffsetPropertyInfo), '("size", SliceListModelSizePropertyInfo)] :: [(Symbol, *)])
#endif

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

sliceListModelModel :: AttrLabelProxy "model"
sliceListModelModel = AttrLabelProxy

sliceListModelOffset :: AttrLabelProxy "offset"
sliceListModelOffset = AttrLabelProxy

sliceListModelSize :: AttrLabelProxy "size"
sliceListModelSize = AttrLabelProxy

#endif

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

#endif

-- method SliceListModel::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The model to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset of the slice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "maximum size of the slice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "SliceListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_slice_list_model_new" gtk_slice_list_model_new :: 
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    Word32 ->                               -- offset : TBasicType TUInt
    Word32 ->                               -- size : TBasicType TUInt
    IO (Ptr SliceListModel)

-- | Creates a new slice model that presents the slice from /@offset@/ to
-- /@offset@/ + /@size@/ our of the given /@model@/.
sliceListModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    a
    -- ^ /@model@/: The model to use
    -> Word32
    -- ^ /@offset@/: the offset of the slice
    -> Word32
    -- ^ /@size@/: maximum size of the slice
    -> m SliceListModel
    -- ^ __Returns:__ A new t'GI.Gtk.Objects.SliceListModel.SliceListModel'
sliceListModelNew :: a -> Word32 -> Word32 -> m SliceListModel
sliceListModelNew model :: a
model offset :: Word32
offset size :: Word32
size = IO SliceListModel -> m SliceListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SliceListModel -> m SliceListModel)
-> IO SliceListModel -> m SliceListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr ListModel
model' <- a -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr SliceListModel
result <- Ptr ListModel -> Word32 -> Word32 -> IO (Ptr SliceListModel)
gtk_slice_list_model_new Ptr ListModel
model' Word32
offset Word32
size
    Text -> Ptr SliceListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "sliceListModelNew" Ptr SliceListModel
result
    SliceListModel
result' <- ((ManagedPtr SliceListModel -> SliceListModel)
-> Ptr SliceListModel -> IO SliceListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SliceListModel -> SliceListModel
SliceListModel) Ptr SliceListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    SliceListModel -> IO SliceListModel
forall (m :: * -> *) a. Monad m => a -> m a
return SliceListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SliceListModel::new_for_type
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "item_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of items" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "SliceListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_slice_list_model_new_for_type" gtk_slice_list_model_new_for_type :: 
    CGType ->                               -- item_type : TBasicType TGType
    IO (Ptr SliceListModel)

-- | Creates a new empty t'GI.Gtk.Objects.SliceListModel.SliceListModel' for the given /@itemType@/ that
-- can be set up later.
sliceListModelNewForType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@itemType@/: the type of items
    -> m SliceListModel
    -- ^ __Returns:__ a new empty t'GI.Gtk.Objects.SliceListModel.SliceListModel'
sliceListModelNewForType :: GType -> m SliceListModel
sliceListModelNewForType itemType :: GType
itemType = IO SliceListModel -> m SliceListModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SliceListModel -> m SliceListModel)
-> IO SliceListModel -> m SliceListModel
forall a b. (a -> b) -> a -> b
$ do
    let itemType' :: CGType
itemType' = GType -> CGType
gtypeToCGType GType
itemType
    Ptr SliceListModel
result <- CGType -> IO (Ptr SliceListModel)
gtk_slice_list_model_new_for_type CGType
itemType'
    Text -> Ptr SliceListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "sliceListModelNewForType" Ptr SliceListModel
result
    SliceListModel
result' <- ((ManagedPtr SliceListModel -> SliceListModel)
-> Ptr SliceListModel -> IO SliceListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SliceListModel -> SliceListModel
SliceListModel) Ptr SliceListModel
result
    SliceListModel -> IO SliceListModel
forall (m :: * -> *) a. Monad m => a -> m a
return SliceListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SliceListModel::get_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SliceListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSliceListModel"
--                 , 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_slice_list_model_get_model" gtk_slice_list_model_get_model :: 
    Ptr SliceListModel ->                   -- self : TInterface (Name {namespace = "Gtk", name = "SliceListModel"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Gets the model that is curently being used or 'P.Nothing' if none.
sliceListModelGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsSliceListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SliceListModel.SliceListModel'
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ The model in use
sliceListModelGetModel :: a -> m (Maybe ListModel)
sliceListModelGetModel 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 SliceListModel
self' <- a -> IO (Ptr SliceListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr SliceListModel -> IO (Ptr ListModel)
gtk_slice_list_model_get_model Ptr SliceListModel
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 SliceListModelGetModelMethodInfo
instance (signature ~ (m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsSliceListModel a) => O.MethodInfo SliceListModelGetModelMethodInfo a signature where
    overloadedMethod = sliceListModelGetModel

#endif

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

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

-- | Gets the offset set via 'GI.Gtk.Objects.SliceListModel.sliceListModelSetOffset'
sliceListModelGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsSliceListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SliceListModel.SliceListModel'
    -> m Word32
    -- ^ __Returns:__ The offset
sliceListModelGetOffset :: a -> m Word32
sliceListModelGetOffset self :: a
self = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SliceListModel
self' <- a -> IO (Ptr SliceListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr SliceListModel -> IO Word32
gtk_slice_list_model_get_offset Ptr SliceListModel
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SliceListModelGetOffsetMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSliceListModel a) => O.MethodInfo SliceListModelGetOffsetMethodInfo a signature where
    overloadedMethod = sliceListModelGetOffset

#endif

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

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

-- | Gets the size set via 'GI.Gtk.Objects.SliceListModel.sliceListModelSetSize'.
sliceListModelGetSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsSliceListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SliceListModel.SliceListModel'
    -> m Word32
    -- ^ __Returns:__ The size
sliceListModelGetSize :: a -> m Word32
sliceListModelGetSize self :: a
self = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SliceListModel
self' <- a -> IO (Ptr SliceListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr SliceListModel -> IO Word32
gtk_slice_list_model_get_size Ptr SliceListModel
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SliceListModelGetSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSliceListModel a) => O.MethodInfo SliceListModelGetSizeMethodInfo a signature where
    overloadedMethod = sliceListModelGetSize

#endif

-- method SliceListModel::set_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SliceListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSliceListModel"
--                 , 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 sliced"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the model to show a slice of. The model\'s item type must conform
-- to /@self@/\'s item type.
sliceListModelSetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsSliceListModel a, Gio.ListModel.IsListModel b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SliceListModel.SliceListModel'
    -> Maybe (b)
    -- ^ /@model@/: The model to be sliced
    -> m ()
sliceListModelSetModel :: a -> Maybe b -> m ()
sliceListModelSetModel 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 SliceListModel
self' <- a -> IO (Ptr SliceListModel)
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 SliceListModel -> Ptr ListModel -> IO ()
gtk_slice_list_model_set_model Ptr SliceListModel
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 SliceListModelSetModelMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSliceListModel a, Gio.ListModel.IsListModel b) => O.MethodInfo SliceListModelSetModelMethodInfo a signature where
    overloadedMethod = sliceListModelSetModel

#endif

-- method SliceListModel::set_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SliceListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSliceListModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new offset to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_slice_list_model_set_offset" gtk_slice_list_model_set_offset :: 
    Ptr SliceListModel ->                   -- self : TInterface (Name {namespace = "Gtk", name = "SliceListModel"})
    Word32 ->                               -- offset : TBasicType TUInt
    IO ()

-- | Sets the offset into the original model for this slice.
-- 
-- If the offset is too large for the sliced model,
-- /@self@/ will end up empty.
sliceListModelSetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsSliceListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SliceListModel.SliceListModel'
    -> Word32
    -- ^ /@offset@/: the new offset to use
    -> m ()
sliceListModelSetOffset :: a -> Word32 -> m ()
sliceListModelSetOffset self :: a
self offset :: Word32
offset = 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 SliceListModel
self' <- a -> IO (Ptr SliceListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SliceListModel -> Word32 -> IO ()
gtk_slice_list_model_set_offset Ptr SliceListModel
self' Word32
offset
    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 SliceListModelSetOffsetMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsSliceListModel a) => O.MethodInfo SliceListModelSetOffsetMethodInfo a signature where
    overloadedMethod = sliceListModelSetOffset

#endif

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

foreign import ccall "gtk_slice_list_model_set_size" gtk_slice_list_model_set_size :: 
    Ptr SliceListModel ->                   -- self : TInterface (Name {namespace = "Gtk", name = "SliceListModel"})
    Word32 ->                               -- size : TBasicType TUInt
    IO ()

-- | Sets the maximum size. /@self@/ will never have more items
-- than /@size@/.
-- 
-- It can however have fewer items if the offset is too large or
-- the model sliced from doesn\'t have enough items.
sliceListModelSetSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsSliceListModel a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.SliceListModel.SliceListModel'
    -> Word32
    -- ^ /@size@/: the maximum size
    -> m ()
sliceListModelSetSize :: a -> Word32 -> m ()
sliceListModelSetSize self :: a
self size :: Word32
size = 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 SliceListModel
self' <- a -> IO (Ptr SliceListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SliceListModel -> Word32 -> IO ()
gtk_slice_list_model_set_size Ptr SliceListModel
self' Word32
size
    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 SliceListModelSetSizeMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsSliceListModel a) => O.MethodInfo SliceListModelSetSizeMethodInfo a signature where
    overloadedMethod = sliceListModelSetSize

#endif