{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkColumnViewColumn@ represents the columns being added to @GtkColumnView@.
-- 
-- The main ingredient for a @GtkColumnViewColumn@ is the @GtkListItemFactory@
-- that tells the columnview how to create cells for this column from items in
-- the model.
-- 
-- Columns have a title, and can optionally have a header menu set
-- with 'GI.Gtk.Objects.ColumnViewColumn.columnViewColumnSetHeaderMenu'.
-- 
-- A sorter can be associated with a column using
-- 'GI.Gtk.Objects.ColumnViewColumn.columnViewColumnSetSorter', to let users influence sorting
-- by clicking on the column header.

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

module GI.Gtk.Objects.ColumnViewColumn
    ( 

-- * Exported types
    ColumnViewColumn(..)                    ,
    IsColumnViewColumn                      ,
    toColumnViewColumn                      ,


 -- * 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"), [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
-- [getColumnView]("GI.Gtk.Objects.ColumnViewColumn#g:method:getColumnView"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getExpand]("GI.Gtk.Objects.ColumnViewColumn#g:method:getExpand"), [getFactory]("GI.Gtk.Objects.ColumnViewColumn#g:method:getFactory"), [getFixedWidth]("GI.Gtk.Objects.ColumnViewColumn#g:method:getFixedWidth"), [getHeaderMenu]("GI.Gtk.Objects.ColumnViewColumn#g:method:getHeaderMenu"), [getId]("GI.Gtk.Objects.ColumnViewColumn#g:method:getId"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getResizable]("GI.Gtk.Objects.ColumnViewColumn#g:method:getResizable"), [getSorter]("GI.Gtk.Objects.ColumnViewColumn#g:method:getSorter"), [getTitle]("GI.Gtk.Objects.ColumnViewColumn#g:method:getTitle"), [getVisible]("GI.Gtk.Objects.ColumnViewColumn#g:method:getVisible").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setExpand]("GI.Gtk.Objects.ColumnViewColumn#g:method:setExpand"), [setFactory]("GI.Gtk.Objects.ColumnViewColumn#g:method:setFactory"), [setFixedWidth]("GI.Gtk.Objects.ColumnViewColumn#g:method:setFixedWidth"), [setHeaderMenu]("GI.Gtk.Objects.ColumnViewColumn#g:method:setHeaderMenu"), [setId]("GI.Gtk.Objects.ColumnViewColumn#g:method:setId"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setResizable]("GI.Gtk.Objects.ColumnViewColumn#g:method:setResizable"), [setSorter]("GI.Gtk.Objects.ColumnViewColumn#g:method:setSorter"), [setTitle]("GI.Gtk.Objects.ColumnViewColumn#g:method:setTitle"), [setVisible]("GI.Gtk.Objects.ColumnViewColumn#g:method:setVisible").

#if defined(ENABLE_OVERLOADING)
    ResolveColumnViewColumnMethod           ,
#endif

-- ** getColumnView #method:getColumnView#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetColumnViewMethodInfo ,
#endif
    columnViewColumnGetColumnView           ,


-- ** getExpand #method:getExpand#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetExpandMethodInfo     ,
#endif
    columnViewColumnGetExpand               ,


-- ** getFactory #method:getFactory#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetFactoryMethodInfo    ,
#endif
    columnViewColumnGetFactory              ,


-- ** getFixedWidth #method:getFixedWidth#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetFixedWidthMethodInfo ,
#endif
    columnViewColumnGetFixedWidth           ,


-- ** getHeaderMenu #method:getHeaderMenu#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetHeaderMenuMethodInfo ,
#endif
    columnViewColumnGetHeaderMenu           ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetIdMethodInfo         ,
#endif
    columnViewColumnGetId                   ,


-- ** getResizable #method:getResizable#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetResizableMethodInfo  ,
#endif
    columnViewColumnGetResizable            ,


-- ** getSorter #method:getSorter#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetSorterMethodInfo     ,
#endif
    columnViewColumnGetSorter               ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetTitleMethodInfo      ,
#endif
    columnViewColumnGetTitle                ,


-- ** getVisible #method:getVisible#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnGetVisibleMethodInfo    ,
#endif
    columnViewColumnGetVisible              ,


-- ** new #method:new#

    columnViewColumnNew                     ,


-- ** setExpand #method:setExpand#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetExpandMethodInfo     ,
#endif
    columnViewColumnSetExpand               ,


-- ** setFactory #method:setFactory#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetFactoryMethodInfo    ,
#endif
    columnViewColumnSetFactory              ,


-- ** setFixedWidth #method:setFixedWidth#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetFixedWidthMethodInfo ,
#endif
    columnViewColumnSetFixedWidth           ,


-- ** setHeaderMenu #method:setHeaderMenu#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetHeaderMenuMethodInfo ,
#endif
    columnViewColumnSetHeaderMenu           ,


-- ** setId #method:setId#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetIdMethodInfo         ,
#endif
    columnViewColumnSetId                   ,


-- ** setResizable #method:setResizable#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetResizableMethodInfo  ,
#endif
    columnViewColumnSetResizable            ,


-- ** setSorter #method:setSorter#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetSorterMethodInfo     ,
#endif
    columnViewColumnSetSorter               ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetTitleMethodInfo      ,
#endif
    columnViewColumnSetTitle                ,


-- ** setVisible #method:setVisible#

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSetVisibleMethodInfo    ,
#endif
    columnViewColumnSetVisible              ,




 -- * Properties


-- ** columnView #attr:columnView#
-- | The @GtkColumnView@ this column is a part of.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnColumnViewPropertyInfo  ,
#endif
#if defined(ENABLE_OVERLOADING)
    columnViewColumnColumnView              ,
#endif
    getColumnViewColumnColumnView           ,


-- ** expand #attr:expand#
-- | Column gets share of extra width allocated to the view.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnExpandPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    columnViewColumnExpand                  ,
#endif
    constructColumnViewColumnExpand         ,
    getColumnViewColumnExpand               ,
    setColumnViewColumnExpand               ,


-- ** factory #attr:factory#
-- | Factory for populating list items.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnFactoryPropertyInfo     ,
#endif
    clearColumnViewColumnFactory            ,
#if defined(ENABLE_OVERLOADING)
    columnViewColumnFactory                 ,
#endif
    constructColumnViewColumnFactory        ,
    getColumnViewColumnFactory              ,
    setColumnViewColumnFactory              ,


-- ** fixedWidth #attr:fixedWidth#
-- | If not -1, this is the width that the column is allocated,
-- regardless of the size of its content.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnFixedWidthPropertyInfo  ,
#endif
#if defined(ENABLE_OVERLOADING)
    columnViewColumnFixedWidth              ,
#endif
    constructColumnViewColumnFixedWidth     ,
    getColumnViewColumnFixedWidth           ,
    setColumnViewColumnFixedWidth           ,


-- ** headerMenu #attr:headerMenu#
-- | Menu model used to create the context menu for the column header.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnHeaderMenuPropertyInfo  ,
#endif
    clearColumnViewColumnHeaderMenu         ,
#if defined(ENABLE_OVERLOADING)
    columnViewColumnHeaderMenu              ,
#endif
    constructColumnViewColumnHeaderMenu     ,
    getColumnViewColumnHeaderMenu           ,
    setColumnViewColumnHeaderMenu           ,


-- ** id #attr:id#
-- | An ID for the column.
-- 
-- GTK is not currently using the ID for anything, but
-- it can be used by applications when saving column view
-- configurations.
-- 
-- It is up to applications to ensure uniqueness of IDs.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnIdPropertyInfo          ,
#endif
    clearColumnViewColumnId                 ,
#if defined(ENABLE_OVERLOADING)
    columnViewColumnId                      ,
#endif
    constructColumnViewColumnId             ,
    getColumnViewColumnId                   ,
    setColumnViewColumnId                   ,


-- ** resizable #attr:resizable#
-- | Whether this column is resizable.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnResizablePropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    columnViewColumnResizable               ,
#endif
    constructColumnViewColumnResizable      ,
    getColumnViewColumnResizable            ,
    setColumnViewColumnResizable            ,


-- ** sorter #attr:sorter#
-- | Sorter for sorting items according to this column.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnSorterPropertyInfo      ,
#endif
    clearColumnViewColumnSorter             ,
#if defined(ENABLE_OVERLOADING)
    columnViewColumnSorter                  ,
#endif
    constructColumnViewColumnSorter         ,
    getColumnViewColumnSorter               ,
    setColumnViewColumnSorter               ,


-- ** title #attr:title#
-- | Title displayed in the header.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnTitlePropertyInfo       ,
#endif
    clearColumnViewColumnTitle              ,
#if defined(ENABLE_OVERLOADING)
    columnViewColumnTitle                   ,
#endif
    constructColumnViewColumnTitle          ,
    getColumnViewColumnTitle                ,
    setColumnViewColumnTitle                ,


-- ** visible #attr:visible#
-- | Whether this column is visible.

#if defined(ENABLE_OVERLOADING)
    ColumnViewColumnVisiblePropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    columnViewColumnVisible                 ,
#endif
    constructColumnViewColumnVisible        ,
    getColumnViewColumnVisible              ,
    setColumnViewColumnVisible              ,




    ) 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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import {-# SOURCE #-} qualified GI.Gtk.Objects.ColumnView as Gtk.ColumnView
import {-# SOURCE #-} qualified GI.Gtk.Objects.ListItemFactory as Gtk.ListItemFactory
import {-# SOURCE #-} qualified GI.Gtk.Objects.Sorter as Gtk.Sorter

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

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

foreign import ccall "gtk_column_view_column_get_type"
    c_gtk_column_view_column_get_type :: IO B.Types.GType

instance B.Types.TypedObject ColumnViewColumn where
    glibType :: IO GType
glibType = IO GType
c_gtk_column_view_column_get_type

instance B.Types.GObject ColumnViewColumn

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

instance O.HasParentTypes ColumnViewColumn
type instance O.ParentTypes ColumnViewColumn = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveColumnViewColumnMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveColumnViewColumnMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveColumnViewColumnMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveColumnViewColumnMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveColumnViewColumnMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveColumnViewColumnMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveColumnViewColumnMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveColumnViewColumnMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveColumnViewColumnMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveColumnViewColumnMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveColumnViewColumnMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveColumnViewColumnMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveColumnViewColumnMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveColumnViewColumnMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveColumnViewColumnMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveColumnViewColumnMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveColumnViewColumnMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveColumnViewColumnMethod "getColumnView" o = ColumnViewColumnGetColumnViewMethodInfo
    ResolveColumnViewColumnMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveColumnViewColumnMethod "getExpand" o = ColumnViewColumnGetExpandMethodInfo
    ResolveColumnViewColumnMethod "getFactory" o = ColumnViewColumnGetFactoryMethodInfo
    ResolveColumnViewColumnMethod "getFixedWidth" o = ColumnViewColumnGetFixedWidthMethodInfo
    ResolveColumnViewColumnMethod "getHeaderMenu" o = ColumnViewColumnGetHeaderMenuMethodInfo
    ResolveColumnViewColumnMethod "getId" o = ColumnViewColumnGetIdMethodInfo
    ResolveColumnViewColumnMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveColumnViewColumnMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveColumnViewColumnMethod "getResizable" o = ColumnViewColumnGetResizableMethodInfo
    ResolveColumnViewColumnMethod "getSorter" o = ColumnViewColumnGetSorterMethodInfo
    ResolveColumnViewColumnMethod "getTitle" o = ColumnViewColumnGetTitleMethodInfo
    ResolveColumnViewColumnMethod "getVisible" o = ColumnViewColumnGetVisibleMethodInfo
    ResolveColumnViewColumnMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveColumnViewColumnMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveColumnViewColumnMethod "setExpand" o = ColumnViewColumnSetExpandMethodInfo
    ResolveColumnViewColumnMethod "setFactory" o = ColumnViewColumnSetFactoryMethodInfo
    ResolveColumnViewColumnMethod "setFixedWidth" o = ColumnViewColumnSetFixedWidthMethodInfo
    ResolveColumnViewColumnMethod "setHeaderMenu" o = ColumnViewColumnSetHeaderMenuMethodInfo
    ResolveColumnViewColumnMethod "setId" o = ColumnViewColumnSetIdMethodInfo
    ResolveColumnViewColumnMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveColumnViewColumnMethod "setResizable" o = ColumnViewColumnSetResizableMethodInfo
    ResolveColumnViewColumnMethod "setSorter" o = ColumnViewColumnSetSorterMethodInfo
    ResolveColumnViewColumnMethod "setTitle" o = ColumnViewColumnSetTitleMethodInfo
    ResolveColumnViewColumnMethod "setVisible" o = ColumnViewColumnSetVisibleMethodInfo
    ResolveColumnViewColumnMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "column-view"
   -- Type: TInterface (Name {namespace = "Gtk", name = "ColumnView"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnColumnViewPropertyInfo
instance AttrInfo ColumnViewColumnColumnViewPropertyInfo where
    type AttrAllowedOps ColumnViewColumnColumnViewPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ColumnViewColumnColumnViewPropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnColumnViewPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ColumnViewColumnColumnViewPropertyInfo = (~) ()
    type AttrTransferType ColumnViewColumnColumnViewPropertyInfo = ()
    type AttrGetType ColumnViewColumnColumnViewPropertyInfo = (Maybe Gtk.ColumnView.ColumnView)
    type AttrLabel ColumnViewColumnColumnViewPropertyInfo = "column-view"
    type AttrOrigin ColumnViewColumnColumnViewPropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnColumnView
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.columnView"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:columnView"
        })
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@expand@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructColumnViewColumnExpand :: (IsColumnViewColumn o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructColumnViewColumnExpand :: forall o (m :: * -> *).
(IsColumnViewColumn o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructColumnViewColumnExpand Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"expand" Bool
val

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnExpandPropertyInfo
instance AttrInfo ColumnViewColumnExpandPropertyInfo where
    type AttrAllowedOps ColumnViewColumnExpandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ColumnViewColumnExpandPropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnExpandPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ColumnViewColumnExpandPropertyInfo = (~) Bool
    type AttrTransferType ColumnViewColumnExpandPropertyInfo = Bool
    type AttrGetType ColumnViewColumnExpandPropertyInfo = Bool
    type AttrLabel ColumnViewColumnExpandPropertyInfo = "expand"
    type AttrOrigin ColumnViewColumnExpandPropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnExpand
    attrSet = setColumnViewColumnExpand
    attrTransfer _ v = do
        return v
    attrConstruct = constructColumnViewColumnExpand
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.expand"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:expand"
        })
#endif

-- VVV Prop "factory"
   -- Type: TInterface (Name {namespace = "Gtk", name = "ListItemFactory"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@factory@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' columnViewColumn [ #factory 'Data.GI.Base.Attributes.:=' value ]
-- @
setColumnViewColumnFactory :: (MonadIO m, IsColumnViewColumn o, Gtk.ListItemFactory.IsListItemFactory a) => o -> a -> m ()
setColumnViewColumnFactory :: forall (m :: * -> *) o a.
(MonadIO m, IsColumnViewColumn o, IsListItemFactory a) =>
o -> a -> m ()
setColumnViewColumnFactory o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"factory" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@factory@” 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' #factory
-- @
clearColumnViewColumnFactory :: (MonadIO m, IsColumnViewColumn o) => o -> m ()
clearColumnViewColumnFactory :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> m ()
clearColumnViewColumnFactory o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe ListItemFactory -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"factory" (Maybe ListItemFactory
forall a. Maybe a
Nothing :: Maybe Gtk.ListItemFactory.ListItemFactory)

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnFactoryPropertyInfo
instance AttrInfo ColumnViewColumnFactoryPropertyInfo where
    type AttrAllowedOps ColumnViewColumnFactoryPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ColumnViewColumnFactoryPropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnFactoryPropertyInfo = Gtk.ListItemFactory.IsListItemFactory
    type AttrTransferTypeConstraint ColumnViewColumnFactoryPropertyInfo = Gtk.ListItemFactory.IsListItemFactory
    type AttrTransferType ColumnViewColumnFactoryPropertyInfo = Gtk.ListItemFactory.ListItemFactory
    type AttrGetType ColumnViewColumnFactoryPropertyInfo = (Maybe Gtk.ListItemFactory.ListItemFactory)
    type AttrLabel ColumnViewColumnFactoryPropertyInfo = "factory"
    type AttrOrigin ColumnViewColumnFactoryPropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnFactory
    attrSet = setColumnViewColumnFactory
    attrTransfer _ v = do
        unsafeCastTo Gtk.ListItemFactory.ListItemFactory v
    attrConstruct = constructColumnViewColumnFactory
    attrClear = clearColumnViewColumnFactory
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.factory"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:factory"
        })
#endif

-- VVV Prop "fixed-width"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@fixed-width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' columnViewColumn #fixedWidth
-- @
getColumnViewColumnFixedWidth :: (MonadIO m, IsColumnViewColumn o) => o -> m Int32
getColumnViewColumnFixedWidth :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> m Int32
getColumnViewColumnFixedWidth o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"fixed-width"

-- | Set the value of the “@fixed-width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' columnViewColumn [ #fixedWidth 'Data.GI.Base.Attributes.:=' value ]
-- @
setColumnViewColumnFixedWidth :: (MonadIO m, IsColumnViewColumn o) => o -> Int32 -> m ()
setColumnViewColumnFixedWidth :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> Int32 -> m ()
setColumnViewColumnFixedWidth o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"fixed-width" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@fixed-width@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructColumnViewColumnFixedWidth :: (IsColumnViewColumn o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructColumnViewColumnFixedWidth :: forall o (m :: * -> *).
(IsColumnViewColumn o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructColumnViewColumnFixedWidth Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"fixed-width" Int32
val

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnFixedWidthPropertyInfo
instance AttrInfo ColumnViewColumnFixedWidthPropertyInfo where
    type AttrAllowedOps ColumnViewColumnFixedWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ColumnViewColumnFixedWidthPropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnFixedWidthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ColumnViewColumnFixedWidthPropertyInfo = (~) Int32
    type AttrTransferType ColumnViewColumnFixedWidthPropertyInfo = Int32
    type AttrGetType ColumnViewColumnFixedWidthPropertyInfo = Int32
    type AttrLabel ColumnViewColumnFixedWidthPropertyInfo = "fixed-width"
    type AttrOrigin ColumnViewColumnFixedWidthPropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnFixedWidth
    attrSet = setColumnViewColumnFixedWidth
    attrTransfer _ v = do
        return v
    attrConstruct = constructColumnViewColumnFixedWidth
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.fixedWidth"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:fixedWidth"
        })
#endif

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

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

-- | Set the value of the “@header-menu@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' columnViewColumn [ #headerMenu 'Data.GI.Base.Attributes.:=' value ]
-- @
setColumnViewColumnHeaderMenu :: (MonadIO m, IsColumnViewColumn o, Gio.MenuModel.IsMenuModel a) => o -> a -> m ()
setColumnViewColumnHeaderMenu :: forall (m :: * -> *) o a.
(MonadIO m, IsColumnViewColumn o, IsMenuModel a) =>
o -> a -> m ()
setColumnViewColumnHeaderMenu o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"header-menu" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@header-menu@” 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' #headerMenu
-- @
clearColumnViewColumnHeaderMenu :: (MonadIO m, IsColumnViewColumn o) => o -> m ()
clearColumnViewColumnHeaderMenu :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> m ()
clearColumnViewColumnHeaderMenu o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe MenuModel -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"header-menu" (Maybe MenuModel
forall a. Maybe a
Nothing :: Maybe Gio.MenuModel.MenuModel)

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnHeaderMenuPropertyInfo
instance AttrInfo ColumnViewColumnHeaderMenuPropertyInfo where
    type AttrAllowedOps ColumnViewColumnHeaderMenuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ColumnViewColumnHeaderMenuPropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnHeaderMenuPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferTypeConstraint ColumnViewColumnHeaderMenuPropertyInfo = Gio.MenuModel.IsMenuModel
    type AttrTransferType ColumnViewColumnHeaderMenuPropertyInfo = Gio.MenuModel.MenuModel
    type AttrGetType ColumnViewColumnHeaderMenuPropertyInfo = (Maybe Gio.MenuModel.MenuModel)
    type AttrLabel ColumnViewColumnHeaderMenuPropertyInfo = "header-menu"
    type AttrOrigin ColumnViewColumnHeaderMenuPropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnHeaderMenu
    attrSet = setColumnViewColumnHeaderMenu
    attrTransfer _ v = do
        unsafeCastTo Gio.MenuModel.MenuModel v
    attrConstruct = constructColumnViewColumnHeaderMenu
    attrClear = clearColumnViewColumnHeaderMenu
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.headerMenu"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:headerMenu"
        })
#endif

-- VVV Prop "id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' columnViewColumn #id
-- @
getColumnViewColumnId :: (MonadIO m, IsColumnViewColumn o) => o -> m (Maybe T.Text)
getColumnViewColumnId :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> m (Maybe Text)
getColumnViewColumnId o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"id"

-- | Set the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' columnViewColumn [ #id 'Data.GI.Base.Attributes.:=' value ]
-- @
setColumnViewColumnId :: (MonadIO m, IsColumnViewColumn o) => o -> T.Text -> m ()
setColumnViewColumnId :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> Text -> m ()
setColumnViewColumnId o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"id" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructColumnViewColumnId :: (IsColumnViewColumn o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructColumnViewColumnId :: forall o (m :: * -> *).
(IsColumnViewColumn o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructColumnViewColumnId Text
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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@id@” 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' #id
-- @
clearColumnViewColumnId :: (MonadIO m, IsColumnViewColumn o) => o -> m ()
clearColumnViewColumnId :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> m ()
clearColumnViewColumnId o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"id" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnIdPropertyInfo
instance AttrInfo ColumnViewColumnIdPropertyInfo where
    type AttrAllowedOps ColumnViewColumnIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ColumnViewColumnIdPropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ColumnViewColumnIdPropertyInfo = (~) T.Text
    type AttrTransferType ColumnViewColumnIdPropertyInfo = T.Text
    type AttrGetType ColumnViewColumnIdPropertyInfo = (Maybe T.Text)
    type AttrLabel ColumnViewColumnIdPropertyInfo = "id"
    type AttrOrigin ColumnViewColumnIdPropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnId
    attrSet = setColumnViewColumnId
    attrTransfer _ v = do
        return v
    attrConstruct = constructColumnViewColumnId
    attrClear = clearColumnViewColumnId
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:id"
        })
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@resizable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructColumnViewColumnResizable :: (IsColumnViewColumn o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructColumnViewColumnResizable :: forall o (m :: * -> *).
(IsColumnViewColumn o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructColumnViewColumnResizable Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"resizable" Bool
val

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnResizablePropertyInfo
instance AttrInfo ColumnViewColumnResizablePropertyInfo where
    type AttrAllowedOps ColumnViewColumnResizablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ColumnViewColumnResizablePropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnResizablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ColumnViewColumnResizablePropertyInfo = (~) Bool
    type AttrTransferType ColumnViewColumnResizablePropertyInfo = Bool
    type AttrGetType ColumnViewColumnResizablePropertyInfo = Bool
    type AttrLabel ColumnViewColumnResizablePropertyInfo = "resizable"
    type AttrOrigin ColumnViewColumnResizablePropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnResizable
    attrSet = setColumnViewColumnResizable
    attrTransfer _ v = do
        return v
    attrConstruct = constructColumnViewColumnResizable
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.resizable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:resizable"
        })
#endif

-- VVV Prop "sorter"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Sorter"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@sorter@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' columnViewColumn [ #sorter 'Data.GI.Base.Attributes.:=' value ]
-- @
setColumnViewColumnSorter :: (MonadIO m, IsColumnViewColumn o, Gtk.Sorter.IsSorter a) => o -> a -> m ()
setColumnViewColumnSorter :: forall (m :: * -> *) o a.
(MonadIO m, IsColumnViewColumn o, IsSorter a) =>
o -> a -> m ()
setColumnViewColumnSorter o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"sorter" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@sorter@” 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' #sorter
-- @
clearColumnViewColumnSorter :: (MonadIO m, IsColumnViewColumn o) => o -> m ()
clearColumnViewColumnSorter :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> m ()
clearColumnViewColumnSorter o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Sorter -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"sorter" (Maybe Sorter
forall a. Maybe a
Nothing :: Maybe Gtk.Sorter.Sorter)

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSorterPropertyInfo
instance AttrInfo ColumnViewColumnSorterPropertyInfo where
    type AttrAllowedOps ColumnViewColumnSorterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ColumnViewColumnSorterPropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnSorterPropertyInfo = Gtk.Sorter.IsSorter
    type AttrTransferTypeConstraint ColumnViewColumnSorterPropertyInfo = Gtk.Sorter.IsSorter
    type AttrTransferType ColumnViewColumnSorterPropertyInfo = Gtk.Sorter.Sorter
    type AttrGetType ColumnViewColumnSorterPropertyInfo = (Maybe Gtk.Sorter.Sorter)
    type AttrLabel ColumnViewColumnSorterPropertyInfo = "sorter"
    type AttrOrigin ColumnViewColumnSorterPropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnSorter
    attrSet = setColumnViewColumnSorter
    attrTransfer _ v = do
        unsafeCastTo Gtk.Sorter.Sorter v
    attrConstruct = constructColumnViewColumnSorter
    attrClear = clearColumnViewColumnSorter
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.sorter"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:sorter"
        })
#endif

-- VVV Prop "title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' columnViewColumn #title
-- @
getColumnViewColumnTitle :: (MonadIO m, IsColumnViewColumn o) => o -> m (Maybe T.Text)
getColumnViewColumnTitle :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> m (Maybe Text)
getColumnViewColumnTitle o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"title"

-- | Set the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' columnViewColumn [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setColumnViewColumnTitle :: (MonadIO m, IsColumnViewColumn o) => o -> T.Text -> m ()
setColumnViewColumnTitle :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> Text -> m ()
setColumnViewColumnTitle o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@title@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructColumnViewColumnTitle :: (IsColumnViewColumn o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructColumnViewColumnTitle :: forall o (m :: * -> *).
(IsColumnViewColumn o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructColumnViewColumnTitle Text
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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@title@” 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' #title
-- @
clearColumnViewColumnTitle :: (MonadIO m, IsColumnViewColumn o) => o -> m ()
clearColumnViewColumnTitle :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewColumn o) =>
o -> m ()
clearColumnViewColumnTitle o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnTitlePropertyInfo
instance AttrInfo ColumnViewColumnTitlePropertyInfo where
    type AttrAllowedOps ColumnViewColumnTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ColumnViewColumnTitlePropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ColumnViewColumnTitlePropertyInfo = (~) T.Text
    type AttrTransferType ColumnViewColumnTitlePropertyInfo = T.Text
    type AttrGetType ColumnViewColumnTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel ColumnViewColumnTitlePropertyInfo = "title"
    type AttrOrigin ColumnViewColumnTitlePropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnTitle
    attrSet = setColumnViewColumnTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructColumnViewColumnTitle
    attrClear = clearColumnViewColumnTitle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:title"
        })
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@visible@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructColumnViewColumnVisible :: (IsColumnViewColumn o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructColumnViewColumnVisible :: forall o (m :: * -> *).
(IsColumnViewColumn o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructColumnViewColumnVisible Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"visible" Bool
val

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnVisiblePropertyInfo
instance AttrInfo ColumnViewColumnVisiblePropertyInfo where
    type AttrAllowedOps ColumnViewColumnVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ColumnViewColumnVisiblePropertyInfo = IsColumnViewColumn
    type AttrSetTypeConstraint ColumnViewColumnVisiblePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ColumnViewColumnVisiblePropertyInfo = (~) Bool
    type AttrTransferType ColumnViewColumnVisiblePropertyInfo = Bool
    type AttrGetType ColumnViewColumnVisiblePropertyInfo = Bool
    type AttrLabel ColumnViewColumnVisiblePropertyInfo = "visible"
    type AttrOrigin ColumnViewColumnVisiblePropertyInfo = ColumnViewColumn
    attrGet = getColumnViewColumnVisible
    attrSet = setColumnViewColumnVisible
    attrTransfer _ v = do
        return v
    attrConstruct = constructColumnViewColumnVisible
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewColumn.visible"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-ColumnViewColumn.html#g:attr:visible"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ColumnViewColumn
type instance O.AttributeList ColumnViewColumn = ColumnViewColumnAttributeList
type ColumnViewColumnAttributeList = ('[ '("columnView", ColumnViewColumnColumnViewPropertyInfo), '("expand", ColumnViewColumnExpandPropertyInfo), '("factory", ColumnViewColumnFactoryPropertyInfo), '("fixedWidth", ColumnViewColumnFixedWidthPropertyInfo), '("headerMenu", ColumnViewColumnHeaderMenuPropertyInfo), '("id", ColumnViewColumnIdPropertyInfo), '("resizable", ColumnViewColumnResizablePropertyInfo), '("sorter", ColumnViewColumnSorterPropertyInfo), '("title", ColumnViewColumnTitlePropertyInfo), '("visible", ColumnViewColumnVisiblePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
columnViewColumnColumnView :: AttrLabelProxy "columnView"
columnViewColumnColumnView = AttrLabelProxy

columnViewColumnExpand :: AttrLabelProxy "expand"
columnViewColumnExpand = AttrLabelProxy

columnViewColumnFactory :: AttrLabelProxy "factory"
columnViewColumnFactory = AttrLabelProxy

columnViewColumnFixedWidth :: AttrLabelProxy "fixedWidth"
columnViewColumnFixedWidth = AttrLabelProxy

columnViewColumnHeaderMenu :: AttrLabelProxy "headerMenu"
columnViewColumnHeaderMenu = AttrLabelProxy

columnViewColumnId :: AttrLabelProxy "id"
columnViewColumnId = AttrLabelProxy

columnViewColumnResizable :: AttrLabelProxy "resizable"
columnViewColumnResizable = AttrLabelProxy

columnViewColumnSorter :: AttrLabelProxy "sorter"
columnViewColumnSorter = AttrLabelProxy

columnViewColumnTitle :: AttrLabelProxy "title"
columnViewColumnTitle = AttrLabelProxy

columnViewColumnVisible :: AttrLabelProxy "visible"
columnViewColumnVisible = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ColumnViewColumn = ColumnViewColumnSignalList
type ColumnViewColumnSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method ColumnViewColumn::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Title to use for this column"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ListItemFactory" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The factory to populate items with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_new" gtk_column_view_column_new :: 
    CString ->                              -- title : TBasicType TUTF8
    Ptr Gtk.ListItemFactory.ListItemFactory -> -- factory : TInterface (Name {namespace = "Gtk", name = "ListItemFactory"})
    IO (Ptr ColumnViewColumn)

-- | Creates a new @GtkColumnViewColumn@ that uses the given /@factory@/ for
-- mapping items to widgets.
-- 
-- You most likely want to call 'GI.Gtk.Objects.ColumnView.columnViewAppendColumn' next.
-- 
-- The function takes ownership of the argument, so you can write code like:
-- 
-- 
-- === /c code/
-- >column = gtk_column_view_column_new (_("Name"),
-- >  gtk_builder_list_item_factory_new_from_resource ("/name.ui"));
columnViewColumnNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.ListItemFactory.IsListItemFactory a) =>
    Maybe (T.Text)
    -- ^ /@title@/: Title to use for this column
    -> Maybe (a)
    -- ^ /@factory@/: The factory to populate items with
    -> m ColumnViewColumn
    -- ^ __Returns:__ a new @GtkColumnViewColumn@ using the given /@factory@/
columnViewColumnNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListItemFactory a) =>
Maybe Text -> Maybe a -> m ColumnViewColumn
columnViewColumnNew Maybe Text
title Maybe a
factory = IO ColumnViewColumn -> m ColumnViewColumn
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ColumnViewColumn -> m ColumnViewColumn)
-> IO ColumnViewColumn -> m ColumnViewColumn
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeTitle <- case Maybe Text
title of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jTitle -> do
            Ptr CChar
jTitle' <- Text -> IO (Ptr CChar)
textToCString Text
jTitle
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jTitle'
    Ptr ListItemFactory
maybeFactory <- case Maybe a
factory of
        Maybe a
Nothing -> Ptr ListItemFactory -> IO (Ptr ListItemFactory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListItemFactory
forall a. Ptr a
nullPtr
        Just a
jFactory -> do
            Ptr ListItemFactory
jFactory' <- a -> IO (Ptr ListItemFactory)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject a
jFactory
            Ptr ListItemFactory -> IO (Ptr ListItemFactory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListItemFactory
jFactory'
    Ptr ColumnViewColumn
result <- Ptr CChar -> Ptr ListItemFactory -> IO (Ptr ColumnViewColumn)
gtk_column_view_column_new Ptr CChar
maybeTitle Ptr ListItemFactory
maybeFactory
    Text -> Ptr ColumnViewColumn -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"columnViewColumnNew" Ptr ColumnViewColumn
result
    ColumnViewColumn
result' <- ((ManagedPtr ColumnViewColumn -> ColumnViewColumn)
-> Ptr ColumnViewColumn -> IO ColumnViewColumn
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ColumnViewColumn -> ColumnViewColumn
ColumnViewColumn) Ptr ColumnViewColumn
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
factory a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeTitle
    ColumnViewColumn -> IO ColumnViewColumn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColumnViewColumn
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_column_view_column_get_column_view" gtk_column_view_column_get_column_view :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    IO (Ptr Gtk.ColumnView.ColumnView)

-- | Gets the column view that\'s currently displaying this column.
-- 
-- If /@self@/ has not been added to a column view yet, 'P.Nothing' is returned.
columnViewColumnGetColumnView ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m (Maybe Gtk.ColumnView.ColumnView)
    -- ^ __Returns:__ The column view displaying /@self@/.
columnViewColumnGetColumnView :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m (Maybe ColumnView)
columnViewColumnGetColumnView a
self = IO (Maybe ColumnView) -> m (Maybe ColumnView)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ColumnView) -> m (Maybe ColumnView))
-> IO (Maybe ColumnView) -> m (Maybe ColumnView)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ColumnView
result <- Ptr ColumnViewColumn -> IO (Ptr ColumnView)
gtk_column_view_column_get_column_view Ptr ColumnViewColumn
self'
    Maybe ColumnView
maybeResult <- Ptr ColumnView
-> (Ptr ColumnView -> IO ColumnView) -> IO (Maybe ColumnView)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ColumnView
result ((Ptr ColumnView -> IO ColumnView) -> IO (Maybe ColumnView))
-> (Ptr ColumnView -> IO ColumnView) -> IO (Maybe ColumnView)
forall a b. (a -> b) -> a -> b
$ \Ptr ColumnView
result' -> do
        ColumnView
result'' <- ((ManagedPtr ColumnView -> ColumnView)
-> Ptr ColumnView -> IO ColumnView
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ColumnView -> ColumnView
Gtk.ColumnView.ColumnView) Ptr ColumnView
result'
        ColumnView -> IO ColumnView
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColumnView
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ColumnView -> IO (Maybe ColumnView)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ColumnView
maybeResult

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetColumnViewMethodInfo
instance (signature ~ (m (Maybe Gtk.ColumnView.ColumnView)), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetColumnViewMethodInfo a signature where
    overloadedMethod = columnViewColumnGetColumnView

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


#endif

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

-- | Returns whether this column should expand.
columnViewColumnGetExpand ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this column expands
columnViewColumnGetExpand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m Bool
columnViewColumnGetExpand a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ColumnViewColumn -> IO CInt
gtk_column_view_column_get_expand Ptr ColumnViewColumn
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetExpandMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetExpandMethodInfo a signature where
    overloadedMethod = columnViewColumnGetExpand

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


#endif

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

foreign import ccall "gtk_column_view_column_get_factory" gtk_column_view_column_get_factory :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    IO (Ptr Gtk.ListItemFactory.ListItemFactory)

-- | Gets the factory that\'s currently used to populate list items for
-- this column.
columnViewColumnGetFactory ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m (Maybe Gtk.ListItemFactory.ListItemFactory)
    -- ^ __Returns:__ The factory in use
columnViewColumnGetFactory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m (Maybe ListItemFactory)
columnViewColumnGetFactory a
self = IO (Maybe ListItemFactory) -> m (Maybe ListItemFactory)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListItemFactory) -> m (Maybe ListItemFactory))
-> IO (Maybe ListItemFactory) -> m (Maybe ListItemFactory)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListItemFactory
result <- Ptr ColumnViewColumn -> IO (Ptr ListItemFactory)
gtk_column_view_column_get_factory Ptr ColumnViewColumn
self'
    Maybe ListItemFactory
maybeResult <- Ptr ListItemFactory
-> (Ptr ListItemFactory -> IO ListItemFactory)
-> IO (Maybe ListItemFactory)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ListItemFactory
result ((Ptr ListItemFactory -> IO ListItemFactory)
 -> IO (Maybe ListItemFactory))
-> (Ptr ListItemFactory -> IO ListItemFactory)
-> IO (Maybe ListItemFactory)
forall a b. (a -> b) -> a -> b
$ \Ptr ListItemFactory
result' -> do
        ListItemFactory
result'' <- ((ManagedPtr ListItemFactory -> ListItemFactory)
-> Ptr ListItemFactory -> IO ListItemFactory
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListItemFactory -> ListItemFactory
Gtk.ListItemFactory.ListItemFactory) Ptr ListItemFactory
result'
        ListItemFactory -> IO ListItemFactory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListItemFactory
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ListItemFactory -> IO (Maybe ListItemFactory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListItemFactory
maybeResult

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetFactoryMethodInfo
instance (signature ~ (m (Maybe Gtk.ListItemFactory.ListItemFactory)), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetFactoryMethodInfo a signature where
    overloadedMethod = columnViewColumnGetFactory

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


#endif

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

foreign import ccall "gtk_column_view_column_get_fixed_width" gtk_column_view_column_get_fixed_width :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    IO Int32

-- | Gets the fixed width of the column.
columnViewColumnGetFixedWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m Int32
    -- ^ __Returns:__ the fixed with of the column
columnViewColumnGetFixedWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m Int32
columnViewColumnGetFixedWidth a
self = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr ColumnViewColumn -> IO Int32
gtk_column_view_column_get_fixed_width Ptr ColumnViewColumn
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetFixedWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetFixedWidthMethodInfo a signature where
    overloadedMethod = columnViewColumnGetFixedWidth

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


#endif

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

foreign import ccall "gtk_column_view_column_get_header_menu" gtk_column_view_column_get_header_menu :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    IO (Ptr Gio.MenuModel.MenuModel)

-- | Gets the menu model that is used to create the context menu
-- for the column header.
columnViewColumnGetHeaderMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m (Maybe Gio.MenuModel.MenuModel)
    -- ^ __Returns:__ the @GMenuModel@
columnViewColumnGetHeaderMenu :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m (Maybe MenuModel)
columnViewColumnGetHeaderMenu a
self = IO (Maybe MenuModel) -> m (Maybe MenuModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MenuModel) -> m (Maybe MenuModel))
-> IO (Maybe MenuModel) -> m (Maybe MenuModel)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MenuModel
result <- Ptr ColumnViewColumn -> IO (Ptr MenuModel)
gtk_column_view_column_get_header_menu Ptr ColumnViewColumn
self'
    Maybe MenuModel
maybeResult <- Ptr MenuModel
-> (Ptr MenuModel -> IO MenuModel) -> IO (Maybe MenuModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr MenuModel
result ((Ptr MenuModel -> IO MenuModel) -> IO (Maybe MenuModel))
-> (Ptr MenuModel -> IO MenuModel) -> IO (Maybe MenuModel)
forall a b. (a -> b) -> a -> b
$ \Ptr MenuModel
result' -> do
        MenuModel
result'' <- ((ManagedPtr MenuModel -> MenuModel)
-> Ptr MenuModel -> IO MenuModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr MenuModel -> MenuModel
Gio.MenuModel.MenuModel) Ptr MenuModel
result'
        MenuModel -> IO MenuModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MenuModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe MenuModel -> IO (Maybe MenuModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MenuModel
maybeResult

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetHeaderMenuMethodInfo
instance (signature ~ (m (Maybe Gio.MenuModel.MenuModel)), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetHeaderMenuMethodInfo a signature where
    overloadedMethod = columnViewColumnGetHeaderMenu

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


#endif

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

foreign import ccall "gtk_column_view_column_get_id" gtk_column_view_column_get_id :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    IO CString

-- | Returns the ID set with 'GI.Gtk.Objects.ColumnViewColumn.columnViewColumnSetId'.
-- 
-- /Since: 4.10/
columnViewColumnGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The column\'s ID
columnViewColumnGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m (Maybe Text)
columnViewColumnGetId a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr ColumnViewColumn -> IO (Ptr CChar)
gtk_column_view_column_get_id Ptr ColumnViewColumn
self'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetIdMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetIdMethodInfo a signature where
    overloadedMethod = columnViewColumnGetId

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


#endif

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

-- | Returns whether this column is resizable.
columnViewColumnGetResizable ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this column is resizable
columnViewColumnGetResizable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m Bool
columnViewColumnGetResizable a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ColumnViewColumn -> IO CInt
gtk_column_view_column_get_resizable Ptr ColumnViewColumn
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetResizableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetResizableMethodInfo a signature where
    overloadedMethod = columnViewColumnGetResizable

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


#endif

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

foreign import ccall "gtk_column_view_column_get_sorter" gtk_column_view_column_get_sorter :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    IO (Ptr Gtk.Sorter.Sorter)

-- | Returns the sorter that is associated with the column.
columnViewColumnGetSorter ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m (Maybe Gtk.Sorter.Sorter)
    -- ^ __Returns:__ the @GtkSorter@ of /@self@/
columnViewColumnGetSorter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m (Maybe Sorter)
columnViewColumnGetSorter a
self = IO (Maybe Sorter) -> m (Maybe Sorter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Sorter) -> m (Maybe Sorter))
-> IO (Maybe Sorter) -> m (Maybe Sorter)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Sorter
result <- Ptr ColumnViewColumn -> IO (Ptr Sorter)
gtk_column_view_column_get_sorter Ptr ColumnViewColumn
self'
    Maybe Sorter
maybeResult <- Ptr Sorter -> (Ptr Sorter -> IO Sorter) -> IO (Maybe Sorter)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Sorter
result ((Ptr Sorter -> IO Sorter) -> IO (Maybe Sorter))
-> (Ptr Sorter -> IO Sorter) -> IO (Maybe Sorter)
forall a b. (a -> b) -> a -> b
$ \Ptr Sorter
result' -> do
        Sorter
result'' <- ((ManagedPtr Sorter -> Sorter) -> Ptr Sorter -> IO Sorter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Sorter -> Sorter
Gtk.Sorter.Sorter) Ptr Sorter
result'
        Sorter -> IO Sorter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Sorter
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Sorter -> IO (Maybe Sorter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Sorter
maybeResult

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetSorterMethodInfo
instance (signature ~ (m (Maybe Gtk.Sorter.Sorter)), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetSorterMethodInfo a signature where
    overloadedMethod = columnViewColumnGetSorter

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


#endif

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

foreign import ccall "gtk_column_view_column_get_title" gtk_column_view_column_get_title :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    IO CString

-- | Returns the title set with 'GI.Gtk.Objects.ColumnViewColumn.columnViewColumnSetTitle'.
columnViewColumnGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The column\'s title
columnViewColumnGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m (Maybe Text)
columnViewColumnGetTitle a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr ColumnViewColumn -> IO (Ptr CChar)
gtk_column_view_column_get_title Ptr ColumnViewColumn
self'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetTitleMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetTitleMethodInfo a signature where
    overloadedMethod = columnViewColumnGetTitle

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


#endif

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

-- | Returns whether this column is visible.
columnViewColumnGetVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this column is visible
columnViewColumnGetVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> m Bool
columnViewColumnGetVisible a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ColumnViewColumn -> IO CInt
gtk_column_view_column_get_visible Ptr ColumnViewColumn
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnGetVisibleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnGetVisibleMethodInfo a signature where
    overloadedMethod = columnViewColumnGetVisible

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


#endif

-- method ColumnViewColumn::set_expand
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "expand"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if this column should expand to fill available sace"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_set_expand" gtk_column_view_column_set_expand :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    CInt ->                                 -- expand : TBasicType TBoolean
    IO ()

-- | Sets the column to take available extra space.
-- 
-- The extra space is shared equally amongst all columns that
-- have the expand set to 'P.True'.
columnViewColumnSetExpand ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Bool
    -- ^ /@expand@/: 'P.True' if this column should expand to fill available sace
    -> m ()
columnViewColumnSetExpand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> Bool -> m ()
columnViewColumnSetExpand a
self Bool
expand = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let expand' :: CInt
expand' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
expand
    Ptr ColumnViewColumn -> CInt -> IO ()
gtk_column_view_column_set_expand Ptr ColumnViewColumn
self' CInt
expand'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetExpandMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnSetExpandMethodInfo a signature where
    overloadedMethod = columnViewColumnSetExpand

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


#endif

-- method ColumnViewColumn::set_factory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ListItemFactory" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the factory 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_column_view_column_set_factory" gtk_column_view_column_set_factory :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    Ptr Gtk.ListItemFactory.ListItemFactory -> -- factory : TInterface (Name {namespace = "Gtk", name = "ListItemFactory"})
    IO ()

-- | Sets the @GtkListItemFactory@ to use for populating list items for this
-- column.
columnViewColumnSetFactory ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a, Gtk.ListItemFactory.IsListItemFactory b) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Maybe (b)
    -- ^ /@factory@/: the factory to use
    -> m ()
columnViewColumnSetFactory :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsColumnViewColumn a,
 IsListItemFactory b) =>
a -> Maybe b -> m ()
columnViewColumnSetFactory a
self Maybe b
factory = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListItemFactory
maybeFactory <- case Maybe b
factory of
        Maybe b
Nothing -> Ptr ListItemFactory -> IO (Ptr ListItemFactory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListItemFactory
forall a. Ptr a
nullPtr
        Just b
jFactory -> do
            Ptr ListItemFactory
jFactory' <- b -> IO (Ptr ListItemFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFactory
            Ptr ListItemFactory -> IO (Ptr ListItemFactory)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListItemFactory
jFactory'
    Ptr ColumnViewColumn -> Ptr ListItemFactory -> IO ()
gtk_column_view_column_set_factory Ptr ColumnViewColumn
self' Ptr ListItemFactory
maybeFactory
    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
factory b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetFactoryMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsColumnViewColumn a, Gtk.ListItemFactory.IsListItemFactory b) => O.OverloadedMethod ColumnViewColumnSetFactoryMethodInfo a signature where
    overloadedMethod = columnViewColumnSetFactory

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


#endif

-- method ColumnViewColumn::set_fixed_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fixed_width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new fixed width, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_set_fixed_width" gtk_column_view_column_set_fixed_width :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    Int32 ->                                -- fixed_width : TBasicType TInt
    IO ()

-- | If /@fixedWidth@/ is not -1, sets the fixed width of /@column@/;
-- otherwise unsets it.
-- 
-- Setting a fixed width overrides the automatically calculated
-- width. Interactive resizing also sets the “fixed-width” property.
columnViewColumnSetFixedWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Int32
    -- ^ /@fixedWidth@/: the new fixed width, or -1
    -> m ()
columnViewColumnSetFixedWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> Int32 -> m ()
columnViewColumnSetFixedWidth a
self Int32
fixedWidth = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ColumnViewColumn -> Int32 -> IO ()
gtk_column_view_column_set_fixed_width Ptr ColumnViewColumn
self' Int32
fixedWidth
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetFixedWidthMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnSetFixedWidthMethodInfo a signature where
    overloadedMethod = columnViewColumnSetFixedWidth

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


#endif

-- method ColumnViewColumn::set_header_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GMenuModel`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_set_header_menu" gtk_column_view_column_set_header_menu :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    Ptr Gio.MenuModel.MenuModel ->          -- menu : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Sets the menu model that is used to create the context menu
-- for the column header.
columnViewColumnSetHeaderMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Maybe (b)
    -- ^ /@menu@/: a @GMenuModel@
    -> m ()
columnViewColumnSetHeaderMenu :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsColumnViewColumn a, IsMenuModel b) =>
a -> Maybe b -> m ()
columnViewColumnSetHeaderMenu a
self Maybe b
menu = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MenuModel
maybeMenu <- case Maybe b
menu of
        Maybe b
Nothing -> Ptr MenuModel -> IO (Ptr MenuModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
forall a. Ptr a
nullPtr
        Just b
jMenu -> do
            Ptr MenuModel
jMenu' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMenu
            Ptr MenuModel -> IO (Ptr MenuModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MenuModel
jMenu'
    Ptr ColumnViewColumn -> Ptr MenuModel -> IO ()
gtk_column_view_column_set_header_menu Ptr ColumnViewColumn
self' Ptr MenuModel
maybeMenu
    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
menu b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetHeaderMenuMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsColumnViewColumn a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod ColumnViewColumnSetHeaderMenuMethodInfo a signature where
    overloadedMethod = columnViewColumnSetHeaderMenu

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


#endif

-- method ColumnViewColumn::set_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ID to use for this column"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_set_id" gtk_column_view_column_set_id :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    CString ->                              -- id : TBasicType TUTF8
    IO ()

-- | Sets the id of this column.
-- 
-- GTK makes no use of this, but applications can use it when
-- storing column view configuration.
-- 
-- It is up to callers to ensure uniqueness of IDs.
-- 
-- /Since: 4.10/
columnViewColumnSetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Maybe (T.Text)
    -- ^ /@id@/: ID to use for this column
    -> m ()
columnViewColumnSetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> Maybe Text -> m ()
columnViewColumnSetId a
self Maybe Text
id = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            Ptr CChar
jId' <- Text -> IO (Ptr CChar)
textToCString Text
jId
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jId'
    Ptr ColumnViewColumn -> Ptr CChar -> IO ()
gtk_column_view_column_set_id Ptr ColumnViewColumn
self' Ptr CChar
maybeId
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeId
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetIdMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnSetIdMethodInfo a signature where
    overloadedMethod = columnViewColumnSetId

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


#endif

-- method ColumnViewColumn::set_resizable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resizable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether this column should be resizable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_set_resizable" gtk_column_view_column_set_resizable :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    CInt ->                                 -- resizable : TBasicType TBoolean
    IO ()

-- | Sets whether this column should be resizable by dragging.
columnViewColumnSetResizable ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Bool
    -- ^ /@resizable@/: whether this column should be resizable
    -> m ()
columnViewColumnSetResizable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> Bool -> m ()
columnViewColumnSetResizable a
self Bool
resizable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let resizable' :: CInt
resizable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
resizable
    Ptr ColumnViewColumn -> CInt -> IO ()
gtk_column_view_column_set_resizable Ptr ColumnViewColumn
self' CInt
resizable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetResizableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnSetResizableMethodInfo a signature where
    overloadedMethod = columnViewColumnSetResizable

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


#endif

-- method ColumnViewColumn::set_sorter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sorter"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Sorter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GtkSorter` to associate with @column"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_set_sorter" gtk_column_view_column_set_sorter :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    Ptr Gtk.Sorter.Sorter ->                -- sorter : TInterface (Name {namespace = "Gtk", name = "Sorter"})
    IO ()

-- | Associates a sorter with the column.
-- 
-- If /@sorter@/ is 'P.Nothing', the column will not let users change
-- the sorting by clicking on its header.
-- 
-- This sorter can be made active by clicking on the column
-- header, or by calling 'GI.Gtk.Objects.ColumnView.columnViewSortByColumn'.
-- 
-- See 'GI.Gtk.Objects.ColumnView.columnViewGetSorter' for the necessary steps
-- for setting up customizable sorting for t'GI.Gtk.Objects.ColumnView.ColumnView'.
columnViewColumnSetSorter ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a, Gtk.Sorter.IsSorter b) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Maybe (b)
    -- ^ /@sorter@/: the @GtkSorter@ to associate with /@column@/
    -> m ()
columnViewColumnSetSorter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsColumnViewColumn a, IsSorter b) =>
a -> Maybe b -> m ()
columnViewColumnSetSorter a
self Maybe b
sorter = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Sorter
maybeSorter <- case Maybe b
sorter of
        Maybe b
Nothing -> Ptr Sorter -> IO (Ptr Sorter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Sorter
forall a. Ptr a
nullPtr
        Just b
jSorter -> do
            Ptr Sorter
jSorter' <- b -> IO (Ptr Sorter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSorter
            Ptr Sorter -> IO (Ptr Sorter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Sorter
jSorter'
    Ptr ColumnViewColumn -> Ptr Sorter -> IO ()
gtk_column_view_column_set_sorter Ptr ColumnViewColumn
self' Ptr Sorter
maybeSorter
    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
sorter b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetSorterMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsColumnViewColumn a, Gtk.Sorter.IsSorter b) => O.OverloadedMethod ColumnViewColumnSetSorterMethodInfo a signature where
    overloadedMethod = columnViewColumnSetSorter

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


#endif

-- method ColumnViewColumn::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Title to use for this column"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_set_title" gtk_column_view_column_set_title :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the title of this column.
-- 
-- The title is displayed in the header of a @GtkColumnView@
-- for this column and is therefore user-facing text that should
-- be translated.
columnViewColumnSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Maybe (T.Text)
    -- ^ /@title@/: Title to use for this column
    -> m ()
columnViewColumnSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> Maybe Text -> m ()
columnViewColumnSetTitle a
self Maybe Text
title = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeTitle <- case Maybe Text
title of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jTitle -> do
            Ptr CChar
jTitle' <- Text -> IO (Ptr CChar)
textToCString Text
jTitle
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jTitle'
    Ptr ColumnViewColumn -> Ptr CChar -> IO ()
gtk_column_view_column_set_title Ptr ColumnViewColumn
self' Ptr CChar
maybeTitle
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeTitle
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetTitleMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnSetTitleMethodInfo a signature where
    overloadedMethod = columnViewColumnSetTitle

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


#endif

-- method ColumnViewColumn::set_visible
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ColumnViewColumn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkColumnViewColumn`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether this column should be visible"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_column_view_column_set_visible" gtk_column_view_column_set_visible :: 
    Ptr ColumnViewColumn ->                 -- self : TInterface (Name {namespace = "Gtk", name = "ColumnViewColumn"})
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

-- | Sets whether this column should be visible in views.
columnViewColumnSetVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsColumnViewColumn a) =>
    a
    -- ^ /@self@/: a @GtkColumnViewColumn@
    -> Bool
    -- ^ /@visible@/: whether this column should be visible
    -> m ()
columnViewColumnSetVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewColumn a) =>
a -> Bool -> m ()
columnViewColumnSetVisible a
self Bool
visible = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColumnViewColumn
self' <- a -> IO (Ptr ColumnViewColumn)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
visible
    Ptr ColumnViewColumn -> CInt -> IO ()
gtk_column_view_column_set_visible Ptr ColumnViewColumn
self' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColumnViewColumnSetVisibleMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsColumnViewColumn a) => O.OverloadedMethod ColumnViewColumnSetVisibleMethodInfo a signature where
    overloadedMethod = columnViewColumnSetVisible

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


#endif