{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GtkNoSelection is an implementation of the t'GI.Gtk.Interfaces.SelectionModel.SelectionModel' interface
-- that does not allow selecting anything.
-- 
-- This model is meant to be used as a simple wrapper to @/GListModels/@ when a
-- t'GI.Gtk.Interfaces.SelectionModel.SelectionModel' is required.

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

module GI.Gtk.Objects.NoSelection
    ( 

-- * Exported types
    NoSelection(..)                         ,
    IsNoSelection                           ,
    toNoSelection                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveNoSelectionMethod                ,
#endif


-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    NoSelectionGetModelMethodInfo           ,
#endif
    noSelectionGetModel                     ,


-- ** new #method:new#

    noSelectionNew                          ,




 -- * Properties
-- ** model #attr:model#
-- | The model being managed

#if defined(ENABLE_OVERLOADING)
    NoSelectionModelPropertyInfo            ,
#endif
    constructNoSelectionModel               ,
    getNoSelectionModel                     ,
#if defined(ENABLE_OVERLOADING)
    noSelectionModel                        ,
#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.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 Control.Monad.IO.Class as MIO
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
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.SelectionModel as Gtk.SelectionModel

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

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

foreign import ccall "gtk_no_selection_get_type"
    c_gtk_no_selection_get_type :: IO B.Types.GType

instance B.Types.TypedObject NoSelection where
    glibType :: IO GType
glibType = IO GType
c_gtk_no_selection_get_type

instance B.Types.GObject NoSelection

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

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

instance O.HasParentTypes NoSelection
type instance O.ParentTypes NoSelection = '[GObject.Object.Object, Gio.ListModel.ListModel, Gtk.SelectionModel.SelectionModel]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveNoSelectionMethod (t :: Symbol) (o :: *) :: * where
    ResolveNoSelectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveNoSelectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveNoSelectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveNoSelectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveNoSelectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveNoSelectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveNoSelectionMethod "isSelected" o = Gtk.SelectionModel.SelectionModelIsSelectedMethodInfo
    ResolveNoSelectionMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveNoSelectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveNoSelectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveNoSelectionMethod "queryRange" o = Gtk.SelectionModel.SelectionModelQueryRangeMethodInfo
    ResolveNoSelectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveNoSelectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveNoSelectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveNoSelectionMethod "selectAll" o = Gtk.SelectionModel.SelectionModelSelectAllMethodInfo
    ResolveNoSelectionMethod "selectItem" o = Gtk.SelectionModel.SelectionModelSelectItemMethodInfo
    ResolveNoSelectionMethod "selectRange" o = Gtk.SelectionModel.SelectionModelSelectRangeMethodInfo
    ResolveNoSelectionMethod "selectionChanged" o = Gtk.SelectionModel.SelectionModelSelectionChangedMethodInfo
    ResolveNoSelectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveNoSelectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveNoSelectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveNoSelectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveNoSelectionMethod "unselectAll" o = Gtk.SelectionModel.SelectionModelUnselectAllMethodInfo
    ResolveNoSelectionMethod "unselectItem" o = Gtk.SelectionModel.SelectionModelUnselectItemMethodInfo
    ResolveNoSelectionMethod "unselectRange" o = Gtk.SelectionModel.SelectionModelUnselectRangeMethodInfo
    ResolveNoSelectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveNoSelectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveNoSelectionMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveNoSelectionMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveNoSelectionMethod "getModel" o = NoSelectionGetModelMethodInfo
    ResolveNoSelectionMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveNoSelectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveNoSelectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveNoSelectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveNoSelectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveNoSelectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveNoSelectionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

-- | 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' noSelection #model
-- @
getNoSelectionModel :: (MonadIO m, IsNoSelection o) => o -> m Gio.ListModel.ListModel
getNoSelectionModel :: o -> m ListModel
getNoSelectionModel o
obj = IO ListModel -> m ListModel
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
$ Text -> IO (Maybe ListModel) -> IO ListModel
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getNoSelectionModel" (IO (Maybe ListModel) -> IO ListModel)
-> IO (Maybe ListModel) -> IO ListModel
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ListModel -> ListModel)
-> IO (Maybe ListModel)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"model" ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel

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

#if defined(ENABLE_OVERLOADING)
data NoSelectionModelPropertyInfo
instance AttrInfo NoSelectionModelPropertyInfo where
    type AttrAllowedOps NoSelectionModelPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NoSelectionModelPropertyInfo = IsNoSelection
    type AttrSetTypeConstraint NoSelectionModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint NoSelectionModelPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType NoSelectionModelPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType NoSelectionModelPropertyInfo = Gio.ListModel.ListModel
    type AttrLabel NoSelectionModelPropertyInfo = "model"
    type AttrOrigin NoSelectionModelPropertyInfo = NoSelection
    attrGet = getNoSelectionModel
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructNoSelectionModel
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList NoSelection
type instance O.AttributeList NoSelection = NoSelectionAttributeList
type NoSelectionAttributeList = ('[ '("model", NoSelectionModelPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
noSelectionModel :: AttrLabelProxy "model"
noSelectionModel = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList NoSelection = NoSelectionSignalList
type NoSelectionSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("selectionChanged", Gtk.SelectionModel.SelectionModelSelectionChangedSignalInfo)] :: [(Symbol, *)])

#endif

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

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

-- | Creates a new selection to handle /@model@/.
noSelectionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.ListModel.IsListModel a) =>
    a
    -- ^ /@model@/: the t'GI.Gio.Interfaces.ListModel.ListModel' to manage
    -> m NoSelection
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.NoSelection.NoSelection'
noSelectionNew :: a -> m NoSelection
noSelectionNew a
model = IO NoSelection -> m NoSelection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NoSelection -> m NoSelection)
-> IO NoSelection -> m NoSelection
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 NoSelection
result <- Ptr ListModel -> IO (Ptr NoSelection)
gtk_no_selection_new Ptr ListModel
model'
    Text -> Ptr NoSelection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"noSelectionNew" Ptr NoSelection
result
    NoSelection
result' <- ((ManagedPtr NoSelection -> NoSelection)
-> Ptr NoSelection -> IO NoSelection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr NoSelection -> NoSelection
NoSelection) Ptr NoSelection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    NoSelection -> IO NoSelection
forall (m :: * -> *) a. Monad m => a -> m a
return NoSelection
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

-- | Gets the model that /@self@/ is wrapping.
noSelectionGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsNoSelection a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.NoSelection.NoSelection'
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ The model being wrapped
noSelectionGetModel :: a -> m ListModel
noSelectionGetModel a
self = IO ListModel -> m ListModel
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 NoSelection
self' <- a -> IO (Ptr NoSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr NoSelection -> IO (Ptr ListModel)
gtk_no_selection_get_model Ptr NoSelection
self'
    Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"noSelectionGetModel" 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
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ListModel -> IO ListModel
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'

#if defined(ENABLE_OVERLOADING)
data NoSelectionGetModelMethodInfo
instance (signature ~ (m Gio.ListModel.ListModel), MonadIO m, IsNoSelection a) => O.MethodInfo NoSelectionGetModelMethodInfo a signature where
    overloadedMethod = noSelectionGetModel

#endif