{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Dazzle.Objects.DirectoryModel
    ( 

-- * Exported types
    DirectoryModel(..)                      ,
    IsDirectoryModel                        ,
    toDirectoryModel                        ,


 -- * 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"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDirectory]("GI.Dazzle.Objects.DirectoryModel#g:method:getDirectory"), [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
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDirectory]("GI.Dazzle.Objects.DirectoryModel#g:method:setDirectory"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setVisibleFunc]("GI.Dazzle.Objects.DirectoryModel#g:method:setVisibleFunc").

#if defined(ENABLE_OVERLOADING)
    ResolveDirectoryModelMethod             ,
#endif

-- ** getDirectory #method:getDirectory#

#if defined(ENABLE_OVERLOADING)
    DirectoryModelGetDirectoryMethodInfo    ,
#endif
    directoryModelGetDirectory              ,


-- ** new #method:new#

    directoryModelNew                       ,


-- ** setDirectory #method:setDirectory#

#if defined(ENABLE_OVERLOADING)
    DirectoryModelSetDirectoryMethodInfo    ,
#endif
    directoryModelSetDirectory              ,


-- ** setVisibleFunc #method:setVisibleFunc#

#if defined(ENABLE_OVERLOADING)
    DirectoryModelSetVisibleFuncMethodInfo  ,
#endif
    directoryModelSetVisibleFunc            ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    DirectoryModelDirectoryPropertyInfo     ,
#endif
    constructDirectoryModelDirectory        ,
#if defined(ENABLE_OVERLOADING)
    directoryModelDirectory                 ,
#endif
    getDirectoryModelDirectory              ,
    setDirectoryModelDirectory              ,




    ) 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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
import qualified GI.GLib.Callbacks as GLib.Callbacks
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

#else
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
import qualified GI.GLib.Callbacks as GLib.Callbacks
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

#endif

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

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

foreign import ccall "dzl_directory_model_get_type"
    c_dzl_directory_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject DirectoryModel where
    glibType :: IO GType
glibType = IO GType
c_dzl_directory_model_get_type

instance B.Types.GObject DirectoryModel

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDirectoryModelMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDirectoryModelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDirectoryModelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDirectoryModelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDirectoryModelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDirectoryModelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDirectoryModelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDirectoryModelMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveDirectoryModelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDirectoryModelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDirectoryModelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDirectoryModelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDirectoryModelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDirectoryModelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDirectoryModelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDirectoryModelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDirectoryModelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDirectoryModelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDirectoryModelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDirectoryModelMethod "getDirectory" o = DirectoryModelGetDirectoryMethodInfo
    ResolveDirectoryModelMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveDirectoryModelMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveDirectoryModelMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveDirectoryModelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDirectoryModelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDirectoryModelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDirectoryModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDirectoryModelMethod "setDirectory" o = DirectoryModelSetDirectoryMethodInfo
    ResolveDirectoryModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDirectoryModelMethod "setVisibleFunc" o = DirectoryModelSetVisibleFuncMethodInfo
    ResolveDirectoryModelMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data DirectoryModelDirectoryPropertyInfo
instance AttrInfo DirectoryModelDirectoryPropertyInfo where
    type AttrAllowedOps DirectoryModelDirectoryPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DirectoryModelDirectoryPropertyInfo = IsDirectoryModel
    type AttrSetTypeConstraint DirectoryModelDirectoryPropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint DirectoryModelDirectoryPropertyInfo = Gio.File.IsFile
    type AttrTransferType DirectoryModelDirectoryPropertyInfo = Gio.File.File
    type AttrGetType DirectoryModelDirectoryPropertyInfo = Gio.File.File
    type AttrLabel DirectoryModelDirectoryPropertyInfo = "directory"
    type AttrOrigin DirectoryModelDirectoryPropertyInfo = DirectoryModel
    attrGet = getDirectoryModelDirectory
    attrSet = setDirectoryModelDirectory
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructDirectoryModelDirectory
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryModel.directory"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryModel.html#g:attr:directory"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DirectoryModel
type instance O.AttributeList DirectoryModel = DirectoryModelAttributeList
type DirectoryModelAttributeList = ('[ '("directory", DirectoryModelDirectoryPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
directoryModelDirectory :: AttrLabelProxy "directory"
directoryModelDirectory = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "dzl_directory_model_get_directory" dzl_directory_model_get_directory :: 
    Ptr DirectoryModel ->                   -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryModel"})
    IO (Ptr Gio.File.File)

-- | Gets the directory the model is observing.
directoryModelGetDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryModel a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.DirectoryModel.DirectoryModel'
    -> m Gio.File.File
    -- ^ __Returns:__ A t'GI.Gio.Interfaces.File.File'
directoryModelGetDirectory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryModel a) =>
a -> m File
directoryModelGetDirectory a
self = IO File -> m File
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr DirectoryModel
self' <- a -> IO (Ptr DirectoryModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
result <- Ptr DirectoryModel -> IO (Ptr File)
dzl_directory_model_get_directory Ptr DirectoryModel
self'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"directoryModelGetDirectory" Ptr File
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data DirectoryModelGetDirectoryMethodInfo
instance (signature ~ (m Gio.File.File), MonadIO m, IsDirectoryModel a) => O.OverloadedMethod DirectoryModelGetDirectoryMethodInfo a signature where
    overloadedMethod = directoryModelGetDirectory

instance O.OverloadedMethodInfo DirectoryModelGetDirectoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryModel.directoryModelGetDirectory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryModel.html#v:directoryModelGetDirectory"
        })


#endif

-- method DirectoryModel::set_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "DirectoryModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_directory_model_set_directory" dzl_directory_model_set_directory :: 
    Ptr DirectoryModel ->                   -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryModel"})
    Ptr Gio.File.File ->                    -- directory : TInterface (Name {namespace = "Gio", name = "File"})
    IO ()

-- | /No description available in the introspection data./
directoryModelSetDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryModel a, Gio.File.IsFile b) =>
    a
    -> b
    -> m ()
directoryModelSetDirectory :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDirectoryModel a, IsFile b) =>
a -> b -> m ()
directoryModelSetDirectory a
self b
directory = 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 DirectoryModel
self' <- a -> IO (Ptr DirectoryModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
directory' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
directory
    Ptr DirectoryModel -> Ptr File -> IO ()
dzl_directory_model_set_directory Ptr DirectoryModel
self' Ptr File
directory'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
directory
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DirectoryModelSetDirectoryMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsDirectoryModel a, Gio.File.IsFile b) => O.OverloadedMethod DirectoryModelSetDirectoryMethodInfo a signature where
    overloadedMethod = directoryModelSetDirectory

instance O.OverloadedMethodInfo DirectoryModelSetDirectoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryModel.directoryModelSetDirectory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryModel.html#v:directoryModelSetDirectory"
        })


#endif

-- method DirectoryModel::set_visible_func
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "DirectoryModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "DirectoryModelVisibleFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data_free_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_directory_model_set_visible_func" dzl_directory_model_set_visible_func :: 
    Ptr DirectoryModel ->                   -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryModel"})
    FunPtr Dazzle.Callbacks.C_DirectoryModelVisibleFunc -> -- visible_func : TInterface (Name {namespace = "Dazzle", name = "DirectoryModelVisibleFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_data_free_func : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | /No description available in the introspection data./
directoryModelSetVisibleFunc ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryModel a) =>
    a
    -> Dazzle.Callbacks.DirectoryModelVisibleFunc
    -> m ()
directoryModelSetVisibleFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDirectoryModel a) =>
a -> DirectoryModelVisibleFunc -> m ()
directoryModelSetVisibleFunc a
self DirectoryModelVisibleFunc
visibleFunc = 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 DirectoryModel
self' <- a -> IO (Ptr DirectoryModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    FunPtr C_DirectoryModelVisibleFunc
visibleFunc' <- C_DirectoryModelVisibleFunc
-> IO (FunPtr C_DirectoryModelVisibleFunc)
Dazzle.Callbacks.mk_DirectoryModelVisibleFunc (Maybe (Ptr (FunPtr C_DirectoryModelVisibleFunc))
-> DirectoryModelVisibleFunc_WithClosures
-> C_DirectoryModelVisibleFunc
Dazzle.Callbacks.wrap_DirectoryModelVisibleFunc Maybe (Ptr (FunPtr C_DirectoryModelVisibleFunc))
forall a. Maybe a
Nothing (DirectoryModelVisibleFunc -> DirectoryModelVisibleFunc_WithClosures
Dazzle.Callbacks.drop_closures_DirectoryModelVisibleFunc DirectoryModelVisibleFunc
visibleFunc))
    let userData :: Ptr ()
userData = FunPtr C_DirectoryModelVisibleFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_DirectoryModelVisibleFunc
visibleFunc'
    let userDataFreeFunc :: FunPtr (Ptr a -> IO ())
userDataFreeFunc = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr DirectoryModel
-> FunPtr C_DirectoryModelVisibleFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
dzl_directory_model_set_visible_func Ptr DirectoryModel
self' FunPtr C_DirectoryModelVisibleFunc
visibleFunc' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
userDataFreeFunc
    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 DirectoryModelSetVisibleFuncMethodInfo
instance (signature ~ (Dazzle.Callbacks.DirectoryModelVisibleFunc -> m ()), MonadIO m, IsDirectoryModel a) => O.OverloadedMethod DirectoryModelSetVisibleFuncMethodInfo a signature where
    overloadedMethod = directoryModelSetVisibleFunc

instance O.OverloadedMethodInfo DirectoryModelSetVisibleFuncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryModel.directoryModelSetVisibleFunc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryModel.html#v:directoryModelSetVisibleFunc"
        })


#endif

-- method DirectoryModel::new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "directory"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_directory_model_new" dzl_directory_model_new :: 
    Ptr Gio.File.File ->                    -- directory : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Creates a new t'GI.Dazzle.Objects.DirectoryModel.DirectoryModel' using /@directory@/ as the directory to monitor.
directoryModelNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    a
    -- ^ /@directory@/: A t'GI.Gio.Interfaces.File.File'
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ A newly created t'GI.Dazzle.Objects.DirectoryModel.DirectoryModel'
directoryModelNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m ListModel
directoryModelNew a
directory = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
directory' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
directory
    Ptr ListModel
result <- Ptr File -> IO (Ptr ListModel)
dzl_directory_model_new Ptr File
directory'
    Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"directoryModelNew" Ptr ListModel
result
    ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
directory
    ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'

#if defined(ENABLE_OVERLOADING)
#endif