{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.BookmarkList.BookmarkList' is a list model that wraps GBookmarkFile.
-- It presents a t'GI.Gio.Interfaces.ListModel.ListModel' and fills it asynchronously with the @/GFileInfos/@
-- returned from that function.
-- 
-- The @/GFileInfos/@ in the list have some attributes in the recent namespace
-- added: recent[private](#g:signal:private) (boolean) and recent:applications (stringv).

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

module GI.Gtk.Objects.BookmarkList
    ( 

-- * Exported types
    BookmarkList(..)                        ,
    IsBookmarkList                          ,
    toBookmarkList                          ,


 -- * 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"), [isLoading]("GI.Gtk.Objects.BookmarkList#g:method:isLoading"), [itemsChanged]("GI.Gio.Interfaces.ListModel#g:method:itemsChanged"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAttributes]("GI.Gtk.Objects.BookmarkList#g:method:getAttributes"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFilename]("GI.Gtk.Objects.BookmarkList#g:method:getFilename"), [getIoPriority]("GI.Gtk.Objects.BookmarkList#g:method:getIoPriority"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setAttributes]("GI.Gtk.Objects.BookmarkList#g:method:setAttributes"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIoPriority]("GI.Gtk.Objects.BookmarkList#g:method:setIoPriority"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveBookmarkListMethod               ,
#endif

-- ** getAttributes #method:getAttributes#

#if defined(ENABLE_OVERLOADING)
    BookmarkListGetAttributesMethodInfo     ,
#endif
    bookmarkListGetAttributes               ,


-- ** getFilename #method:getFilename#

#if defined(ENABLE_OVERLOADING)
    BookmarkListGetFilenameMethodInfo       ,
#endif
    bookmarkListGetFilename                 ,


-- ** getIoPriority #method:getIoPriority#

#if defined(ENABLE_OVERLOADING)
    BookmarkListGetIoPriorityMethodInfo     ,
#endif
    bookmarkListGetIoPriority               ,


-- ** isLoading #method:isLoading#

#if defined(ENABLE_OVERLOADING)
    BookmarkListIsLoadingMethodInfo         ,
#endif
    bookmarkListIsLoading                   ,


-- ** new #method:new#

    bookmarkListNew                         ,


-- ** setAttributes #method:setAttributes#

#if defined(ENABLE_OVERLOADING)
    BookmarkListSetAttributesMethodInfo     ,
#endif
    bookmarkListSetAttributes               ,


-- ** setIoPriority #method:setIoPriority#

#if defined(ENABLE_OVERLOADING)
    BookmarkListSetIoPriorityMethodInfo     ,
#endif
    bookmarkListSetIoPriority               ,




 -- * Properties


-- ** attributes #attr:attributes#
-- | The attributes to query

#if defined(ENABLE_OVERLOADING)
    BookmarkListAttributesPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    bookmarkListAttributes                  ,
#endif
    clearBookmarkListAttributes             ,
    constructBookmarkListAttributes         ,
    getBookmarkListAttributes               ,
    setBookmarkListAttributes               ,


-- ** filename #attr:filename#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BookmarkListFilenamePropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    bookmarkListFilename                    ,
#endif
    constructBookmarkListFilename           ,
    getBookmarkListFilename                 ,


-- ** ioPriority #attr:ioPriority#
-- | Priority used when loading

#if defined(ENABLE_OVERLOADING)
    BookmarkListIoPriorityPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    bookmarkListIoPriority                  ,
#endif
    constructBookmarkListIoPriority         ,
    getBookmarkListIoPriority               ,
    setBookmarkListIoPriority               ,


-- ** loading #attr:loading#
-- | 'P.True' if files are being loaded

#if defined(ENABLE_OVERLOADING)
    BookmarkListLoadingPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    bookmarkListLoading                     ,
#endif
    getBookmarkListLoading                  ,




    ) 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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

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

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

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

foreign import ccall "gtk_bookmark_list_get_type"
    c_gtk_bookmark_list_get_type :: IO B.Types.GType

instance B.Types.TypedObject BookmarkList where
    glibType :: IO GType
glibType = IO GType
c_gtk_bookmark_list_get_type

instance B.Types.GObject BookmarkList

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

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

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

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

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

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

#endif

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

#endif

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

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

-- | Set the value of the “@attributes@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bookmarkList [ #attributes 'Data.GI.Base.Attributes.:=' value ]
-- @
setBookmarkListAttributes :: (MonadIO m, IsBookmarkList o) => o -> T.Text -> m ()
setBookmarkListAttributes :: forall (m :: * -> *) o.
(MonadIO m, IsBookmarkList o) =>
o -> Text -> m ()
setBookmarkListAttributes o
obj Text
val = IO () -> m ()
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
"attributes" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@attributes@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBookmarkListAttributes :: (IsBookmarkList o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructBookmarkListAttributes :: forall o (m :: * -> *).
(IsBookmarkList o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructBookmarkListAttributes Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
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
"attributes" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data BookmarkListAttributesPropertyInfo
instance AttrInfo BookmarkListAttributesPropertyInfo where
    type AttrAllowedOps BookmarkListAttributesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint BookmarkListAttributesPropertyInfo = IsBookmarkList
    type AttrSetTypeConstraint BookmarkListAttributesPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint BookmarkListAttributesPropertyInfo = (~) T.Text
    type AttrTransferType BookmarkListAttributesPropertyInfo = T.Text
    type AttrGetType BookmarkListAttributesPropertyInfo = (Maybe T.Text)
    type AttrLabel BookmarkListAttributesPropertyInfo = "attributes"
    type AttrOrigin BookmarkListAttributesPropertyInfo = BookmarkList
    attrGet = getBookmarkListAttributes
    attrSet = setBookmarkListAttributes
    attrTransfer _ v = do
        return v
    attrConstruct = constructBookmarkListAttributes
    attrClear = clearBookmarkListAttributes
#endif

-- VVV Prop "filename"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@filename@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bookmarkList #filename
-- @
getBookmarkListFilename :: (MonadIO m, IsBookmarkList o) => o -> m T.Text
getBookmarkListFilename :: forall (m :: * -> *) o.
(MonadIO m, IsBookmarkList o) =>
o -> m Text
getBookmarkListFilename o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getBookmarkListFilename" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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
"filename"

-- | Construct a `GValueConstruct` with valid value for the “@filename@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBookmarkListFilename :: (IsBookmarkList o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructBookmarkListFilename :: forall o (m :: * -> *).
(IsBookmarkList o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructBookmarkListFilename Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
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
"filename" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data BookmarkListFilenamePropertyInfo
instance AttrInfo BookmarkListFilenamePropertyInfo where
    type AttrAllowedOps BookmarkListFilenamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint BookmarkListFilenamePropertyInfo = IsBookmarkList
    type AttrSetTypeConstraint BookmarkListFilenamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint BookmarkListFilenamePropertyInfo = (~) T.Text
    type AttrTransferType BookmarkListFilenamePropertyInfo = T.Text
    type AttrGetType BookmarkListFilenamePropertyInfo = T.Text
    type AttrLabel BookmarkListFilenamePropertyInfo = "filename"
    type AttrOrigin BookmarkListFilenamePropertyInfo = BookmarkList
    attrGet = getBookmarkListFilename
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructBookmarkListFilename
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@io-priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bookmarkList [ #ioPriority 'Data.GI.Base.Attributes.:=' value ]
-- @
setBookmarkListIoPriority :: (MonadIO m, IsBookmarkList o) => o -> Int32 -> m ()
setBookmarkListIoPriority :: forall (m :: * -> *) o.
(MonadIO m, IsBookmarkList o) =>
o -> Int32 -> m ()
setBookmarkListIoPriority o
obj Int32
val = IO () -> m ()
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
"io-priority" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@io-priority@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBookmarkListIoPriority :: (IsBookmarkList o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructBookmarkListIoPriority :: forall o (m :: * -> *).
(IsBookmarkList o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructBookmarkListIoPriority Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
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
"io-priority" Int32
val

#if defined(ENABLE_OVERLOADING)
data BookmarkListIoPriorityPropertyInfo
instance AttrInfo BookmarkListIoPriorityPropertyInfo where
    type AttrAllowedOps BookmarkListIoPriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BookmarkListIoPriorityPropertyInfo = IsBookmarkList
    type AttrSetTypeConstraint BookmarkListIoPriorityPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint BookmarkListIoPriorityPropertyInfo = (~) Int32
    type AttrTransferType BookmarkListIoPriorityPropertyInfo = Int32
    type AttrGetType BookmarkListIoPriorityPropertyInfo = Int32
    type AttrLabel BookmarkListIoPriorityPropertyInfo = "io-priority"
    type AttrOrigin BookmarkListIoPriorityPropertyInfo = BookmarkList
    attrGet = getBookmarkListIoPriority
    attrSet = setBookmarkListIoPriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructBookmarkListIoPriority
    attrClear = undefined
#endif

-- VVV Prop "loading"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data BookmarkListLoadingPropertyInfo
instance AttrInfo BookmarkListLoadingPropertyInfo where
    type AttrAllowedOps BookmarkListLoadingPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint BookmarkListLoadingPropertyInfo = IsBookmarkList
    type AttrSetTypeConstraint BookmarkListLoadingPropertyInfo = (~) ()
    type AttrTransferTypeConstraint BookmarkListLoadingPropertyInfo = (~) ()
    type AttrTransferType BookmarkListLoadingPropertyInfo = ()
    type AttrGetType BookmarkListLoadingPropertyInfo = Bool
    type AttrLabel BookmarkListLoadingPropertyInfo = "loading"
    type AttrOrigin BookmarkListLoadingPropertyInfo = BookmarkList
    attrGet = getBookmarkListLoading
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BookmarkList
type instance O.AttributeList BookmarkList = BookmarkListAttributeList
type BookmarkListAttributeList = ('[ '("attributes", BookmarkListAttributesPropertyInfo), '("filename", BookmarkListFilenamePropertyInfo), '("ioPriority", BookmarkListIoPriorityPropertyInfo), '("loading", BookmarkListLoadingPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
bookmarkListAttributes :: AttrLabelProxy "attributes"
bookmarkListAttributes = AttrLabelProxy

bookmarkListFilename :: AttrLabelProxy "filename"
bookmarkListFilename = AttrLabelProxy

bookmarkListIoPriority :: AttrLabelProxy "ioPriority"
bookmarkListIoPriority = AttrLabelProxy

bookmarkListLoading :: AttrLabelProxy "loading"
bookmarkListLoading = AttrLabelProxy

#endif

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

#endif

-- method BookmarkList::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The bookmark file to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The attributes to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "BookmarkList" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_bookmark_list_new" gtk_bookmark_list_new :: 
    CString ->                              -- filename : TBasicType TUTF8
    CString ->                              -- attributes : TBasicType TUTF8
    IO (Ptr BookmarkList)

-- | Creates a new t'GI.Gtk.Objects.BookmarkList.BookmarkList' with the given /@attributes@/.
bookmarkListNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@filename@/: The bookmark file to load
    -> Maybe (T.Text)
    -- ^ /@attributes@/: The attributes to query
    -> m BookmarkList
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.BookmarkList.BookmarkList'
bookmarkListNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Maybe Text -> m BookmarkList
bookmarkListNew Maybe Text
filename Maybe Text
attributes = IO BookmarkList -> m BookmarkList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BookmarkList -> m BookmarkList)
-> IO BookmarkList -> m BookmarkList
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeFilename <- case Maybe Text
filename of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jFilename -> do
            Ptr CChar
jFilename' <- Text -> IO (Ptr CChar)
textToCString Text
jFilename
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jFilename'
    Ptr CChar
maybeAttributes <- case Maybe Text
attributes of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jAttributes -> do
            Ptr CChar
jAttributes' <- Text -> IO (Ptr CChar)
textToCString Text
jAttributes
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jAttributes'
    Ptr BookmarkList
result <- Ptr CChar -> Ptr CChar -> IO (Ptr BookmarkList)
gtk_bookmark_list_new Ptr CChar
maybeFilename Ptr CChar
maybeAttributes
    Text -> Ptr BookmarkList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bookmarkListNew" Ptr BookmarkList
result
    BookmarkList
result' <- ((ManagedPtr BookmarkList -> BookmarkList)
-> Ptr BookmarkList -> IO BookmarkList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BookmarkList -> BookmarkList
BookmarkList) Ptr BookmarkList
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeFilename
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeAttributes
    BookmarkList -> IO BookmarkList
forall (m :: * -> *) a. Monad m => a -> m a
return BookmarkList
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BookmarkList::get_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BookmarkList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBookmarkList" , 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_bookmark_list_get_attributes" gtk_bookmark_list_get_attributes :: 
    Ptr BookmarkList ->                     -- self : TInterface (Name {namespace = "Gtk", name = "BookmarkList"})
    IO CString

-- | Gets the attributes queried on the children.
bookmarkListGetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsBookmarkList a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.BookmarkList.BookmarkList'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The queried attributes
bookmarkListGetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBookmarkList a) =>
a -> m (Maybe Text)
bookmarkListGetAttributes a
self = IO (Maybe Text) -> m (Maybe Text)
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 BookmarkList
self' <- a -> IO (Ptr BookmarkList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr BookmarkList -> IO (Ptr CChar)
gtk_bookmark_list_get_attributes Ptr BookmarkList
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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

instance O.OverloadedMethodInfo BookmarkListGetAttributesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.BookmarkList.bookmarkListGetAttributes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-BookmarkList.html#v:bookmarkListGetAttributes"
        }


#endif

-- method BookmarkList::get_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BookmarkList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBookmarkList" , 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_bookmark_list_get_filename" gtk_bookmark_list_get_filename :: 
    Ptr BookmarkList ->                     -- self : TInterface (Name {namespace = "Gtk", name = "BookmarkList"})
    IO CString

-- | Returns the filename of the bookmark file that
-- this list is loading.
bookmarkListGetFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsBookmarkList a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.BookmarkList.BookmarkList'
    -> m T.Text
    -- ^ __Returns:__ the filename of the .xbel file
bookmarkListGetFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBookmarkList a) =>
a -> m Text
bookmarkListGetFilename a
self = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BookmarkList
self' <- a -> IO (Ptr BookmarkList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr BookmarkList -> IO (Ptr CChar)
gtk_bookmark_list_get_filename Ptr BookmarkList
self'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bookmarkListGetFilename" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BookmarkListGetFilenameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsBookmarkList a) => O.OverloadedMethod BookmarkListGetFilenameMethodInfo a signature where
    overloadedMethod = bookmarkListGetFilename

instance O.OverloadedMethodInfo BookmarkListGetFilenameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.BookmarkList.bookmarkListGetFilename",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-BookmarkList.html#v:bookmarkListGetFilename"
        }


#endif

-- method BookmarkList::get_io_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BookmarkList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBookmarkList" , 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_bookmark_list_get_io_priority" gtk_bookmark_list_get_io_priority :: 
    Ptr BookmarkList ->                     -- self : TInterface (Name {namespace = "Gtk", name = "BookmarkList"})
    IO Int32

-- | Gets the IO priority set via 'GI.Gtk.Objects.BookmarkList.bookmarkListSetIoPriority'.
bookmarkListGetIoPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsBookmarkList a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.BookmarkList.BookmarkList'
    -> m Int32
    -- ^ __Returns:__ The IO priority.
bookmarkListGetIoPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBookmarkList a) =>
a -> m Int32
bookmarkListGetIoPriority a
self = IO Int32 -> m Int32
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 BookmarkList
self' <- a -> IO (Ptr BookmarkList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr BookmarkList -> IO Int32
gtk_bookmark_list_get_io_priority Ptr BookmarkList
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data BookmarkListGetIoPriorityMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsBookmarkList a) => O.OverloadedMethod BookmarkListGetIoPriorityMethodInfo a signature where
    overloadedMethod = bookmarkListGetIoPriority

instance O.OverloadedMethodInfo BookmarkListGetIoPriorityMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.BookmarkList.bookmarkListGetIoPriority",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-BookmarkList.html#v:bookmarkListGetIoPriority"
        }


#endif

-- method BookmarkList::is_loading
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BookmarkList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBookmarkList" , 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_bookmark_list_is_loading" gtk_bookmark_list_is_loading :: 
    Ptr BookmarkList ->                     -- self : TInterface (Name {namespace = "Gtk", name = "BookmarkList"})
    IO CInt

-- | Returns 'P.True' if the files are currently being loaded.
-- 
-- Files will be added to /@self@/ from time to time while loading is
-- going on. The order in which are added is undefined and may change
-- in between runs.
bookmarkListIsLoading ::
    (B.CallStack.HasCallStack, MonadIO m, IsBookmarkList a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.BookmarkList.BookmarkList'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@self@/ is loading
bookmarkListIsLoading :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBookmarkList a) =>
a -> m Bool
bookmarkListIsLoading a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BookmarkList
self' <- a -> IO (Ptr BookmarkList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr BookmarkList -> IO CInt
gtk_bookmark_list_is_loading Ptr BookmarkList
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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BookmarkListIsLoadingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBookmarkList a) => O.OverloadedMethod BookmarkListIsLoadingMethodInfo a signature where
    overloadedMethod = bookmarkListIsLoading

instance O.OverloadedMethodInfo BookmarkListIsLoadingMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.BookmarkList.bookmarkListIsLoading",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-BookmarkList.html#v:bookmarkListIsLoading"
        }


#endif

-- method BookmarkList::set_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BookmarkList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBookmarkList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attributes to enumerate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the /@attributes@/ to be enumerated and starts the enumeration.
-- 
-- If /@attributes@/ is 'P.Nothing', no attributes will be queried, but a list
-- of @/GFileInfos/@ will still be created.
bookmarkListSetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsBookmarkList a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.BookmarkList.BookmarkList'
    -> Maybe (T.Text)
    -- ^ /@attributes@/: the attributes to enumerate
    -> m ()
bookmarkListSetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBookmarkList a) =>
a -> Maybe Text -> m ()
bookmarkListSetAttributes a
self Maybe Text
attributes = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BookmarkList
self' <- a -> IO (Ptr BookmarkList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeAttributes <- case Maybe Text
attributes of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jAttributes -> do
            Ptr CChar
jAttributes' <- Text -> IO (Ptr CChar)
textToCString Text
jAttributes
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jAttributes'
    Ptr BookmarkList -> Ptr CChar -> IO ()
gtk_bookmark_list_set_attributes Ptr BookmarkList
self' Ptr CChar
maybeAttributes
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeAttributes
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo BookmarkListSetAttributesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.BookmarkList.bookmarkListSetAttributes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-BookmarkList.html#v:bookmarkListSetAttributes"
        }


#endif

-- method BookmarkList::set_io_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BookmarkList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkBookmarkList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "IO priority 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_bookmark_list_set_io_priority" gtk_bookmark_list_set_io_priority :: 
    Ptr BookmarkList ->                     -- self : TInterface (Name {namespace = "Gtk", name = "BookmarkList"})
    Int32 ->                                -- io_priority : TBasicType TInt
    IO ()

-- | Sets the IO priority to use while loading files.
-- 
-- The default IO priority is 'GI.GLib.Constants.PRIORITY_DEFAULT'.
bookmarkListSetIoPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsBookmarkList a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.BookmarkList.BookmarkList'
    -> Int32
    -- ^ /@ioPriority@/: IO priority to use
    -> m ()
bookmarkListSetIoPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBookmarkList a) =>
a -> Int32 -> m ()
bookmarkListSetIoPriority a
self Int32
ioPriority = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BookmarkList
self' <- a -> IO (Ptr BookmarkList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr BookmarkList -> Int32 -> IO ()
gtk_bookmark_list_set_io_priority Ptr BookmarkList
self' Int32
ioPriority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BookmarkListSetIoPriorityMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsBookmarkList a) => O.OverloadedMethod BookmarkListSetIoPriorityMethodInfo a signature where
    overloadedMethod = bookmarkListSetIoPriority

instance O.OverloadedMethodInfo BookmarkListSetIoPriorityMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.BookmarkList.bookmarkListSetIoPriority",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-BookmarkList.html#v:bookmarkListSetIoPriority"
        }


#endif