{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkDirectoryList@ is a list model that wraps 'GI.Gio.Interfaces.File.fileEnumerateChildrenAsync'.
-- 
-- It presents a @GListModel@ and fills it asynchronously with the @GFileInfo@s
-- returned from that function.
-- 
-- Enumeration will start automatically when a the
-- [DirectoryList:file]("GI.Gtk.Objects.DirectoryList#g:attr:file") property is set.
-- 
-- While the @GtkDirectoryList@ is being filled, the
-- [DirectoryList:loading]("GI.Gtk.Objects.DirectoryList#g:attr:loading") property will be set to 'P.True'. You can
-- listen to that property if you want to show information like a @GtkSpinner@
-- or a \"Loading...\" text.
-- 
-- If loading fails at any point, the [DirectoryList:error]("GI.Gtk.Objects.DirectoryList#g:attr:error")
-- property will be set to give more indication about the failure.
-- 
-- The @GFileInfo@s returned from a @GtkDirectoryList@ have the \"standard[file](#g:signal:file)\"
-- attribute set to the @GFile@ they refer to. This way you can get at the file
-- that is referred to in the same way you would via 'GI.Gio.Objects.FileEnumerator.fileEnumeratorGetChild'.
-- This means you do not need access to the @GtkDirectoryList@, but can access
-- the @GFile@ directly from the @GFileInfo@ when operating with a @GtkListView@
-- or similar.

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

module GI.Gtk.Objects.DirectoryList
    ( 

-- * Exported types
    DirectoryList(..)                       ,
    IsDirectoryList                         ,
    toDirectoryList                         ,


 -- * 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.DirectoryList#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.DirectoryList#g:method:getAttributes"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getError]("GI.Gtk.Objects.DirectoryList#g:method:getError"), [getFile]("GI.Gtk.Objects.DirectoryList#g:method:getFile"), [getIoPriority]("GI.Gtk.Objects.DirectoryList#g:method:getIoPriority"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getMonitored]("GI.Gtk.Objects.DirectoryList#g:method:getMonitored"), [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.DirectoryList#g:method:setAttributes"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFile]("GI.Gtk.Objects.DirectoryList#g:method:setFile"), [setIoPriority]("GI.Gtk.Objects.DirectoryList#g:method:setIoPriority"), [setMonitored]("GI.Gtk.Objects.DirectoryList#g:method:setMonitored"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDirectoryListMethod              ,
#endif

-- ** getAttributes #method:getAttributes#

#if defined(ENABLE_OVERLOADING)
    DirectoryListGetAttributesMethodInfo    ,
#endif
    directoryListGetAttributes              ,


-- ** getError #method:getError#

#if defined(ENABLE_OVERLOADING)
    DirectoryListGetErrorMethodInfo         ,
#endif
    directoryListGetError                   ,


-- ** getFile #method:getFile#

#if defined(ENABLE_OVERLOADING)
    DirectoryListGetFileMethodInfo          ,
#endif
    directoryListGetFile                    ,


-- ** getIoPriority #method:getIoPriority#

#if defined(ENABLE_OVERLOADING)
    DirectoryListGetIoPriorityMethodInfo    ,
#endif
    directoryListGetIoPriority              ,


-- ** getMonitored #method:getMonitored#

#if defined(ENABLE_OVERLOADING)
    DirectoryListGetMonitoredMethodInfo     ,
#endif
    directoryListGetMonitored               ,


-- ** isLoading #method:isLoading#

#if defined(ENABLE_OVERLOADING)
    DirectoryListIsLoadingMethodInfo        ,
#endif
    directoryListIsLoading                  ,


-- ** new #method:new#

    directoryListNew                        ,


-- ** setAttributes #method:setAttributes#

#if defined(ENABLE_OVERLOADING)
    DirectoryListSetAttributesMethodInfo    ,
#endif
    directoryListSetAttributes              ,


-- ** setFile #method:setFile#

#if defined(ENABLE_OVERLOADING)
    DirectoryListSetFileMethodInfo          ,
#endif
    directoryListSetFile                    ,


-- ** setIoPriority #method:setIoPriority#

#if defined(ENABLE_OVERLOADING)
    DirectoryListSetIoPriorityMethodInfo    ,
#endif
    directoryListSetIoPriority              ,


-- ** setMonitored #method:setMonitored#

#if defined(ENABLE_OVERLOADING)
    DirectoryListSetMonitoredMethodInfo     ,
#endif
    directoryListSetMonitored               ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    DirectoryListAttributesPropertyInfo     ,
#endif
    clearDirectoryListAttributes            ,
    constructDirectoryListAttributes        ,
#if defined(ENABLE_OVERLOADING)
    directoryListAttributes                 ,
#endif
    getDirectoryListAttributes              ,
    setDirectoryListAttributes              ,


-- ** error #attr:error#
-- | Error encountered while loading files.

#if defined(ENABLE_OVERLOADING)
    DirectoryListErrorPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    directoryListError                      ,
#endif
    getDirectoryListError                   ,


-- ** file #attr:file#
-- | File to query.

#if defined(ENABLE_OVERLOADING)
    DirectoryListFilePropertyInfo           ,
#endif
    clearDirectoryListFile                  ,
    constructDirectoryListFile              ,
#if defined(ENABLE_OVERLOADING)
    directoryListFile                       ,
#endif
    getDirectoryListFile                    ,
    setDirectoryListFile                    ,


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

#if defined(ENABLE_OVERLOADING)
    DirectoryListIoPriorityPropertyInfo     ,
#endif
    constructDirectoryListIoPriority        ,
#if defined(ENABLE_OVERLOADING)
    directoryListIoPriority                 ,
#endif
    getDirectoryListIoPriority              ,
    setDirectoryListIoPriority              ,


-- ** itemType #attr:itemType#
-- | The type of items. See 'GI.Gio.Interfaces.ListModel.listModelGetItemType'.
-- 
-- /Since: 4.8/

#if defined(ENABLE_OVERLOADING)
    DirectoryListItemTypePropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    directoryListItemType                   ,
#endif
    getDirectoryListItemType                ,


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

#if defined(ENABLE_OVERLOADING)
    DirectoryListLoadingPropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    directoryListLoading                    ,
#endif
    getDirectoryListLoading                 ,


-- ** monitored #attr:monitored#
-- | 'P.True' if the directory is monitored for changed.

#if defined(ENABLE_OVERLOADING)
    DirectoryListMonitoredPropertyInfo      ,
#endif
    constructDirectoryListMonitored         ,
#if defined(ENABLE_OVERLOADING)
    directoryListMonitored                  ,
#endif
    getDirectoryListMonitored               ,
    setDirectoryListMonitored               ,


-- ** nItems #attr:nItems#
-- | The number of items. See 'GI.Gio.Interfaces.ListModel.listModelGetNItems'.
-- 
-- /Since: 4.8/

#if defined(ENABLE_OVERLOADING)
    DirectoryListNItemsPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    directoryListNItems                     ,
#endif
    getDirectoryListNItems                  ,




    ) 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.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel

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

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

foreign import ccall "gtk_directory_list_get_type"
    c_gtk_directory_list_get_type :: IO B.Types.GType

instance B.Types.TypedObject DirectoryList where
    glibType :: IO GType
glibType = IO GType
c_gtk_directory_list_get_type

instance B.Types.GObject DirectoryList

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDirectoryListMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDirectoryListMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDirectoryListMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDirectoryListMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDirectoryListMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDirectoryListMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDirectoryListMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDirectoryListMethod "isLoading" o = DirectoryListIsLoadingMethodInfo
    ResolveDirectoryListMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveDirectoryListMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDirectoryListMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDirectoryListMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDirectoryListMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDirectoryListMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDirectoryListMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDirectoryListMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDirectoryListMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDirectoryListMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDirectoryListMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDirectoryListMethod "getAttributes" o = DirectoryListGetAttributesMethodInfo
    ResolveDirectoryListMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDirectoryListMethod "getError" o = DirectoryListGetErrorMethodInfo
    ResolveDirectoryListMethod "getFile" o = DirectoryListGetFileMethodInfo
    ResolveDirectoryListMethod "getIoPriority" o = DirectoryListGetIoPriorityMethodInfo
    ResolveDirectoryListMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveDirectoryListMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveDirectoryListMethod "getMonitored" o = DirectoryListGetMonitoredMethodInfo
    ResolveDirectoryListMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveDirectoryListMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDirectoryListMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDirectoryListMethod "setAttributes" o = DirectoryListSetAttributesMethodInfo
    ResolveDirectoryListMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDirectoryListMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDirectoryListMethod "setFile" o = DirectoryListSetFileMethodInfo
    ResolveDirectoryListMethod "setIoPriority" o = DirectoryListSetIoPriorityMethodInfo
    ResolveDirectoryListMethod "setMonitored" o = DirectoryListSetMonitoredMethodInfo
    ResolveDirectoryListMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDirectoryListMethod l o = O.MethodResolutionFailed l o

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

#endif

instance (info ~ ResolveDirectoryListMethod t DirectoryList, O.OverloadedMethodInfo info DirectoryList) => OL.IsLabel t (O.MethodProxy info DirectoryList) 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' directoryList #attributes
-- @
getDirectoryListAttributes :: (MonadIO m, IsDirectoryList o) => o -> m (Maybe T.Text)
getDirectoryListAttributes :: forall (m :: * -> *) o.
(MonadIO m, IsDirectoryList o) =>
o -> m (Maybe Text)
getDirectoryListAttributes 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
"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' directoryList [ #attributes 'Data.GI.Base.Attributes.:=' value ]
-- @
setDirectoryListAttributes :: (MonadIO m, IsDirectoryList o) => o -> T.Text -> m ()
setDirectoryListAttributes :: forall (m :: * -> *) o.
(MonadIO m, IsDirectoryList o) =>
o -> Text -> m ()
setDirectoryListAttributes 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
"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`.
constructDirectoryListAttributes :: (IsDirectoryList o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDirectoryListAttributes :: forall o (m :: * -> *).
(IsDirectoryList o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDirectoryListAttributes 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
"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
-- @
clearDirectoryListAttributes :: (MonadIO m, IsDirectoryList o) => o -> m ()
clearDirectoryListAttributes :: forall (m :: * -> *) o. (MonadIO m, IsDirectoryList o) => o -> m ()
clearDirectoryListAttributes 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
"attributes" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

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

-- VVV Prop "error"
   -- Type: TError
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

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

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

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

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

-- | Set the value of the “@file@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' directoryList [ #file 'Data.GI.Base.Attributes.:=' value ]
-- @
setDirectoryListFile :: (MonadIO m, IsDirectoryList o, Gio.File.IsFile a) => o -> a -> m ()
setDirectoryListFile :: forall (m :: * -> *) o a.
(MonadIO m, IsDirectoryList o, IsFile a) =>
o -> a -> m ()
setDirectoryListFile 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
"file" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@file@” 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' #file
-- @
clearDirectoryListFile :: (MonadIO m, IsDirectoryList o) => o -> m ()
clearDirectoryListFile :: forall (m :: * -> *) o. (MonadIO m, IsDirectoryList o) => o -> m ()
clearDirectoryListFile 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 File -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"file" (Maybe File
forall a. Maybe a
Nothing :: Maybe Gio.File.File)

#if defined(ENABLE_OVERLOADING)
data DirectoryListFilePropertyInfo
instance AttrInfo DirectoryListFilePropertyInfo where
    type AttrAllowedOps DirectoryListFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DirectoryListFilePropertyInfo = IsDirectoryList
    type AttrSetTypeConstraint DirectoryListFilePropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint DirectoryListFilePropertyInfo = Gio.File.IsFile
    type AttrTransferType DirectoryListFilePropertyInfo = Gio.File.File
    type AttrGetType DirectoryListFilePropertyInfo = (Maybe Gio.File.File)
    type AttrLabel DirectoryListFilePropertyInfo = "file"
    type AttrOrigin DirectoryListFilePropertyInfo = DirectoryList
    attrGet = getDirectoryListFile
    attrSet = setDirectoryListFile
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructDirectoryListFile
    attrClear = clearDirectoryListFile
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DirectoryList.file"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-DirectoryList.html#g:attr:file"
        })
#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' directoryList #ioPriority
-- @
getDirectoryListIoPriority :: (MonadIO m, IsDirectoryList o) => o -> m Int32
getDirectoryListIoPriority :: forall (m :: * -> *) o.
(MonadIO m, IsDirectoryList o) =>
o -> m Int32
getDirectoryListIoPriority 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
"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' directoryList [ #ioPriority 'Data.GI.Base.Attributes.:=' value ]
-- @
setDirectoryListIoPriority :: (MonadIO m, IsDirectoryList o) => o -> Int32 -> m ()
setDirectoryListIoPriority :: forall (m :: * -> *) o.
(MonadIO m, IsDirectoryList o) =>
o -> Int32 -> m ()
setDirectoryListIoPriority 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
"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`.
constructDirectoryListIoPriority :: (IsDirectoryList o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDirectoryListIoPriority :: forall o (m :: * -> *).
(IsDirectoryList o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructDirectoryListIoPriority 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
"io-priority" Int32
val

#if defined(ENABLE_OVERLOADING)
data DirectoryListIoPriorityPropertyInfo
instance AttrInfo DirectoryListIoPriorityPropertyInfo where
    type AttrAllowedOps DirectoryListIoPriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DirectoryListIoPriorityPropertyInfo = IsDirectoryList
    type AttrSetTypeConstraint DirectoryListIoPriorityPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DirectoryListIoPriorityPropertyInfo = (~) Int32
    type AttrTransferType DirectoryListIoPriorityPropertyInfo = Int32
    type AttrGetType DirectoryListIoPriorityPropertyInfo = Int32
    type AttrLabel DirectoryListIoPriorityPropertyInfo = "io-priority"
    type AttrOrigin DirectoryListIoPriorityPropertyInfo = DirectoryList
    attrGet = getDirectoryListIoPriority
    attrSet = setDirectoryListIoPriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructDirectoryListIoPriority
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DirectoryList.ioPriority"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-DirectoryList.html#g:attr:ioPriority"
        })
#endif

-- VVV Prop "item-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data DirectoryListItemTypePropertyInfo
instance AttrInfo DirectoryListItemTypePropertyInfo where
    type AttrAllowedOps DirectoryListItemTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DirectoryListItemTypePropertyInfo = IsDirectoryList
    type AttrSetTypeConstraint DirectoryListItemTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DirectoryListItemTypePropertyInfo = (~) ()
    type AttrTransferType DirectoryListItemTypePropertyInfo = ()
    type AttrGetType DirectoryListItemTypePropertyInfo = GType
    type AttrLabel DirectoryListItemTypePropertyInfo = "item-type"
    type AttrOrigin DirectoryListItemTypePropertyInfo = DirectoryList
    attrGet = getDirectoryListItemType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DirectoryList.itemType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-DirectoryList.html#g:attr:itemType"
        })
#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' directoryList #loading
-- @
getDirectoryListLoading :: (MonadIO m, IsDirectoryList o) => o -> m Bool
getDirectoryListLoading :: forall (m :: * -> *) o.
(MonadIO m, IsDirectoryList o) =>
o -> m Bool
getDirectoryListLoading 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
"loading"

#if defined(ENABLE_OVERLOADING)
data DirectoryListLoadingPropertyInfo
instance AttrInfo DirectoryListLoadingPropertyInfo where
    type AttrAllowedOps DirectoryListLoadingPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DirectoryListLoadingPropertyInfo = IsDirectoryList
    type AttrSetTypeConstraint DirectoryListLoadingPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DirectoryListLoadingPropertyInfo = (~) ()
    type AttrTransferType DirectoryListLoadingPropertyInfo = ()
    type AttrGetType DirectoryListLoadingPropertyInfo = Bool
    type AttrLabel DirectoryListLoadingPropertyInfo = "loading"
    type AttrOrigin DirectoryListLoadingPropertyInfo = DirectoryList
    attrGet = getDirectoryListLoading
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DirectoryList.loading"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-DirectoryList.html#g:attr:loading"
        })
#endif

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

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

-- | Set the value of the “@monitored@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' directoryList [ #monitored 'Data.GI.Base.Attributes.:=' value ]
-- @
setDirectoryListMonitored :: (MonadIO m, IsDirectoryList o) => o -> Bool -> m ()
setDirectoryListMonitored :: forall (m :: * -> *) o.
(MonadIO m, IsDirectoryList o) =>
o -> Bool -> m ()
setDirectoryListMonitored 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
"monitored" Bool
val

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

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

-- VVV Prop "n-items"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data DirectoryListNItemsPropertyInfo
instance AttrInfo DirectoryListNItemsPropertyInfo where
    type AttrAllowedOps DirectoryListNItemsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DirectoryListNItemsPropertyInfo = IsDirectoryList
    type AttrSetTypeConstraint DirectoryListNItemsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DirectoryListNItemsPropertyInfo = (~) ()
    type AttrTransferType DirectoryListNItemsPropertyInfo = ()
    type AttrGetType DirectoryListNItemsPropertyInfo = Word32
    type AttrLabel DirectoryListNItemsPropertyInfo = "n-items"
    type AttrOrigin DirectoryListNItemsPropertyInfo = DirectoryList
    attrGet = getDirectoryListNItems
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DirectoryList.nItems"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-DirectoryList.html#g:attr:nItems"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DirectoryList
type instance O.AttributeList DirectoryList = DirectoryListAttributeList
type DirectoryListAttributeList = ('[ '("attributes", DirectoryListAttributesPropertyInfo), '("error", DirectoryListErrorPropertyInfo), '("file", DirectoryListFilePropertyInfo), '("ioPriority", DirectoryListIoPriorityPropertyInfo), '("itemType", DirectoryListItemTypePropertyInfo), '("loading", DirectoryListLoadingPropertyInfo), '("monitored", DirectoryListMonitoredPropertyInfo), '("nItems", DirectoryListNItemsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

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

directoryListError :: AttrLabelProxy "error"
directoryListError = AttrLabelProxy

directoryListFile :: AttrLabelProxy "file"
directoryListFile = AttrLabelProxy

directoryListIoPriority :: AttrLabelProxy "ioPriority"
directoryListIoPriority = AttrLabelProxy

directoryListItemType :: AttrLabelProxy "itemType"
directoryListItemType = AttrLabelProxy

directoryListLoading :: AttrLabelProxy "loading"
directoryListLoading = AttrLabelProxy

directoryListMonitored :: AttrLabelProxy "monitored"
directoryListMonitored = AttrLabelProxy

directoryListNItems :: AttrLabelProxy "nItems"
directoryListNItems = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gtk_directory_list_new" gtk_directory_list_new :: 
    CString ->                              -- attributes : TBasicType TUTF8
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr DirectoryList)

-- | Creates a new @GtkDirectoryList@.
-- 
-- The @GtkDirectoryList@ is querying the given /@file@/
-- with the given /@attributes@/.
directoryListNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    Maybe (T.Text)
    -- ^ /@attributes@/: The attributes to query with
    -> Maybe (a)
    -- ^ /@file@/: The file to query
    -> m DirectoryList
    -- ^ __Returns:__ a new @GtkDirectoryList@
directoryListNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
Maybe Text -> Maybe a -> m DirectoryList
directoryListNew Maybe Text
attributes Maybe a
file = IO DirectoryList -> m DirectoryList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirectoryList -> m DirectoryList)
-> IO DirectoryList -> m DirectoryList
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeAttributes <- case Maybe Text
attributes 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
jAttributes -> do
            Ptr CChar
jAttributes' <- Text -> IO (Ptr CChar)
textToCString Text
jAttributes
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jAttributes'
    Ptr File
maybeFile <- case Maybe a
file of
        Maybe a
Nothing -> Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just a
jFile -> do
            Ptr File
jFile' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jFile
            Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jFile'
    Ptr DirectoryList
result <- Ptr CChar -> Ptr File -> IO (Ptr DirectoryList)
gtk_directory_list_new Ptr CChar
maybeAttributes Ptr File
maybeFile
    Text -> Ptr DirectoryList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"directoryListNew" Ptr DirectoryList
result
    DirectoryList
result' <- ((ManagedPtr DirectoryList -> DirectoryList)
-> Ptr DirectoryList -> IO DirectoryList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DirectoryList -> DirectoryList
DirectoryList) Ptr DirectoryList
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
file a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeAttributes
    DirectoryList -> IO DirectoryList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DirectoryList
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

-- | Gets the attributes queried on the children.
directoryListGetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The queried attributes
directoryListGetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> m (Maybe Text)
directoryListGetAttributes 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 DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr DirectoryList -> IO (Ptr CChar)
gtk_directory_list_get_attributes Ptr DirectoryList
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 DirectoryListGetAttributesMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsDirectoryList a) => O.OverloadedMethod DirectoryListGetAttributesMethodInfo a signature where
    overloadedMethod = directoryListGetAttributes

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


#endif

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

foreign import ccall "gtk_directory_list_get_error" gtk_directory_list_get_error :: 
    Ptr DirectoryList ->                    -- self : TInterface (Name {namespace = "Gtk", name = "DirectoryList"})
    IO (Ptr GError)

-- | Gets the loading error, if any.
-- 
-- If an error occurs during the loading process, the loading process
-- will finish and this property allows querying the error that happened.
-- This error will persist until a file is loaded again.
-- 
-- An error being set does not mean that no files were loaded, and all
-- successfully queried files will remain in the list.
directoryListGetError ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> m (Maybe GError)
    -- ^ __Returns:__ The loading error or 'P.Nothing' if
    --   loading finished successfully
directoryListGetError :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> m (Maybe GError)
directoryListGetError a
self = IO (Maybe GError) -> m (Maybe GError)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GError) -> m (Maybe GError))
-> IO (Maybe GError) -> m (Maybe GError)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GError
result <- Ptr DirectoryList -> IO (Ptr GError)
gtk_directory_list_get_error Ptr DirectoryList
self'
    Maybe GError
maybeResult <- Ptr GError -> (Ptr GError -> IO GError) -> IO (Maybe GError)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GError
result ((Ptr GError -> IO GError) -> IO (Maybe GError))
-> (Ptr GError -> IO GError) -> IO (Maybe GError)
forall a b. (a -> b) -> a -> b
$ \Ptr GError
result' -> do
        GError
result'' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
result'
        GError -> IO GError
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GError
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe GError -> IO (Maybe GError)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GError
maybeResult

#if defined(ENABLE_OVERLOADING)
data DirectoryListGetErrorMethodInfo
instance (signature ~ (m (Maybe GError)), MonadIO m, IsDirectoryList a) => O.OverloadedMethod DirectoryListGetErrorMethodInfo a signature where
    overloadedMethod = directoryListGetError

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


#endif

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

foreign import ccall "gtk_directory_list_get_file" gtk_directory_list_get_file :: 
    Ptr DirectoryList ->                    -- self : TInterface (Name {namespace = "Gtk", name = "DirectoryList"})
    IO (Ptr Gio.File.File)

-- | Gets the file whose children are currently enumerated.
directoryListGetFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ The file whose children are enumerated
directoryListGetFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> m (Maybe File)
directoryListGetFile a
self = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
result <- Ptr DirectoryList -> IO (Ptr File)
gtk_directory_list_get_file Ptr DirectoryList
self'
    Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
        File
result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
        File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult

#if defined(ENABLE_OVERLOADING)
data DirectoryListGetFileMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m, IsDirectoryList a) => O.OverloadedMethod DirectoryListGetFileMethodInfo a signature where
    overloadedMethod = directoryListGetFile

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


#endif

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

-- | Gets the IO priority set via 'GI.Gtk.Objects.DirectoryList.directoryListSetIoPriority'.
directoryListGetIoPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> m Int32
    -- ^ __Returns:__ The IO priority.
directoryListGetIoPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> m Int32
directoryListGetIoPriority 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 DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr DirectoryList -> IO Int32
gtk_directory_list_get_io_priority Ptr DirectoryList
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 DirectoryListGetIoPriorityMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsDirectoryList a) => O.OverloadedMethod DirectoryListGetIoPriorityMethodInfo a signature where
    overloadedMethod = directoryListGetIoPriority

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


#endif

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

-- | Returns whether the directory list is monitoring
-- the directory for changes.
directoryListGetMonitored ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the directory is monitored
directoryListGetMonitored :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> m Bool
directoryListGetMonitored 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 DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr DirectoryList -> IO CInt
gtk_directory_list_get_monitored Ptr DirectoryList
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 DirectoryListGetMonitoredMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDirectoryList a) => O.OverloadedMethod DirectoryListGetMonitoredMethodInfo a signature where
    overloadedMethod = directoryListGetMonitored

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


#endif

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

-- | Returns 'P.True' if the children enumeration is currently in
-- progress.
-- 
-- 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.
directoryListIsLoading ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@self@/ is loading
directoryListIsLoading :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> m Bool
directoryListIsLoading 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 DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr DirectoryList -> IO CInt
gtk_directory_list_is_loading Ptr DirectoryList
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 DirectoryListIsLoadingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDirectoryList a) => O.OverloadedMethod DirectoryListIsLoadingMethodInfo a signature where
    overloadedMethod = directoryListIsLoading

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


#endif

-- method DirectoryList::set_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DirectoryList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDirectoryList`"
--                 , 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_directory_list_set_attributes" gtk_directory_list_set_attributes :: 
    Ptr DirectoryList ->                    -- self : TInterface (Name {namespace = "Gtk", name = "DirectoryList"})
    CString ->                              -- attributes : TBasicType TUTF8
    IO ()

-- | Sets the /@attributes@/ to be enumerated and starts the enumeration.
-- 
-- If /@attributes@/ is 'P.Nothing', the list of file infos will still be created, it will just
-- not contain any extra attributes.
directoryListSetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> Maybe (T.Text)
    -- ^ /@attributes@/: the attributes to enumerate
    -> m ()
directoryListSetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> Maybe Text -> m ()
directoryListSetAttributes a
self Maybe Text
attributes = 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 DirectoryList
self' <- a -> IO (Ptr DirectoryList)
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jAttributes'
    Ptr DirectoryList -> Ptr CChar -> IO ()
gtk_directory_list_set_attributes Ptr DirectoryList
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method DirectoryList::set_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DirectoryList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDirectoryList`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GFile` to be enumerated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_directory_list_set_file" gtk_directory_list_set_file :: 
    Ptr DirectoryList ->                    -- self : TInterface (Name {namespace = "Gtk", name = "DirectoryList"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO ()

-- | Sets the /@file@/ to be enumerated and starts the enumeration.
-- 
-- If /@file@/ is 'P.Nothing', the result will be an empty list.
directoryListSetFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a, Gio.File.IsFile b) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> Maybe (b)
    -- ^ /@file@/: the @GFile@ to be enumerated
    -> m ()
directoryListSetFile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDirectoryList a, IsFile b) =>
a -> Maybe b -> m ()
directoryListSetFile a
self Maybe b
file = 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 DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
maybeFile <- case Maybe b
file of
        Maybe b
Nothing -> Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just b
jFile -> do
            Ptr File
jFile' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFile
            Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jFile'
    Ptr DirectoryList -> Ptr File -> IO ()
gtk_directory_list_set_file Ptr DirectoryList
self' Ptr File
maybeFile
    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
file 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 DirectoryListSetFileMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsDirectoryList a, Gio.File.IsFile b) => O.OverloadedMethod DirectoryListSetFileMethodInfo a signature where
    overloadedMethod = directoryListSetFile

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


#endif

-- method DirectoryList::set_io_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DirectoryList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDirectoryList`"
--                 , 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_directory_list_set_io_priority" gtk_directory_list_set_io_priority :: 
    Ptr DirectoryList ->                    -- self : TInterface (Name {namespace = "Gtk", name = "DirectoryList"})
    Int32 ->                                -- io_priority : TBasicType TInt
    IO ()

-- | Sets the IO priority to use while loading directories.
-- 
-- Setting the priority while /@self@/ is loading will reprioritize the
-- ongoing load as soon as possible.
-- 
-- The default IO priority is 'GI.GLib.Constants.PRIORITY_DEFAULT', which is higher than
-- the GTK redraw priority. If you are loading a lot of directories in
-- parallel, lowering it to something like 'GI.GLib.Constants.PRIORITY_DEFAULT_IDLE'
-- may increase responsiveness.
directoryListSetIoPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> Int32
    -- ^ /@ioPriority@/: IO priority to use
    -> m ()
directoryListSetIoPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> Int32 -> m ()
directoryListSetIoPriority a
self Int32
ioPriority = 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 DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr DirectoryList -> Int32 -> IO ()
gtk_directory_list_set_io_priority Ptr DirectoryList
self' Int32
ioPriority
    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 DirectoryListSetIoPriorityMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsDirectoryList a) => O.OverloadedMethod DirectoryListSetIoPriorityMethodInfo a signature where
    overloadedMethod = directoryListSetIoPriority

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


#endif

-- method DirectoryList::set_monitored
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DirectoryList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDirectoryList`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitored"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to monitor the directory for changes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether the directory list will monitor the directory
-- for changes.
-- 
-- If monitoring is enabled, the [itemsChanged](#g:signal:itemsChanged) signal will
-- be emitted when the directory contents change.
-- 
-- 
-- When monitoring is turned on after the initial creation
-- of the directory list, the directory is reloaded to avoid
-- missing files that appeared between the initial loading
-- and when monitoring was turned on.
directoryListSetMonitored ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryList a) =>
    a
    -- ^ /@self@/: a @GtkDirectoryList@
    -> Bool
    -- ^ /@monitored@/: 'P.True' to monitor the directory for changes
    -> m ()
directoryListSetMonitored :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryList a) =>
a -> Bool -> m ()
directoryListSetMonitored a
self Bool
monitored = 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 DirectoryList
self' <- a -> IO (Ptr DirectoryList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let monitored' :: CInt
monitored' = (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
monitored
    Ptr DirectoryList -> CInt -> IO ()
gtk_directory_list_set_monitored Ptr DirectoryList
self' CInt
monitored'
    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 DirectoryListSetMonitoredMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsDirectoryList a) => O.OverloadedMethod DirectoryListSetMonitoredMethodInfo a signature where
    overloadedMethod = directoryListSetMonitored

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


#endif