{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An opaque structure representing an opened directory.

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

module GI.GLib.Structs.Dir
    ( 

-- * Exported types
    Dir(..)                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [close]("GI.GLib.Structs.Dir#g:method:close"), [readName]("GI.GLib.Structs.Dir#g:method:readName"), [ref]("GI.GLib.Structs.Dir#g:method:ref"), [rewind]("GI.GLib.Structs.Dir#g:method:rewind"), [unref]("GI.GLib.Structs.Dir#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveDirMethod                        ,
#endif

-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    DirCloseMethodInfo                      ,
#endif
    dirClose                                ,


-- ** makeTmp #method:makeTmp#

    dirMakeTmp                              ,


-- ** open #method:open#

    dirOpen                                 ,


-- ** readName #method:readName#

#if defined(ENABLE_OVERLOADING)
    DirReadNameMethodInfo                   ,
#endif
    dirReadName                             ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DirRefMethodInfo                        ,
#endif
    dirRef                                  ,


-- ** rewind #method:rewind#

#if defined(ENABLE_OVERLOADING)
    DirRewindMethodInfo                     ,
#endif
    dirRewind                               ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DirUnrefMethodInfo                      ,
#endif
    dirUnref                                ,




    ) 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)

#else

#endif

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

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

foreign import ccall "g_dir_get_type" c_g_dir_get_type :: 
    IO GType

type instance O.ParentTypes Dir = '[]
instance O.HasParentTypes Dir

instance B.Types.TypedObject Dir where
    glibType :: IO GType
glibType = IO GType
c_g_dir_get_type

instance B.Types.GBoxed Dir

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Dir
type instance O.AttributeList Dir = DirAttributeList
type DirAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method Dir::open
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the path to the directory you are interested in. On Unix\n        in the on-disk encoding. On Windows in UTF-8"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Currently must be set to 0. Reserved for future use."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Dir" })
-- throws : True
-- Skip return : False

foreign import ccall "g_dir_open" g_dir_open :: 
    CString ->                              -- path : TBasicType TUTF8
    Word32 ->                               -- flags : TBasicType TUInt
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Dir)

-- | Opens a directory for reading. The names of the files in the
-- directory can then be retrieved using 'GI.GLib.Structs.Dir.dirReadName'.  Note
-- that the ordering is not defined.
dirOpen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@path@/: the path to the directory you are interested in. On Unix
    --         in the on-disk encoding. On Windows in UTF-8
    -> Word32
    -- ^ /@flags@/: Currently must be set to 0. Reserved for future use.
    -> m Dir
    -- ^ __Returns:__ a newly allocated t'GI.GLib.Structs.Dir.Dir' on success, 'P.Nothing' on failure.
    --   If non-'P.Nothing', you must free the result with 'GI.GLib.Structs.Dir.dirClose'
    --   when you are finished with it. /(Can throw 'Data.GI.Base.GError.GError')/
dirOpen :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Word32 -> m Dir
dirOpen Text
path Word32
flags = IO Dir -> m Dir
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Dir -> m Dir) -> IO Dir -> m Dir
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    IO Dir -> IO () -> IO Dir
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Dir
result <- (Ptr (Ptr GError) -> IO (Ptr Dir)) -> IO (Ptr Dir)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Dir)) -> IO (Ptr Dir))
-> (Ptr (Ptr GError) -> IO (Ptr Dir)) -> IO (Ptr Dir)
forall a b. (a -> b) -> a -> b
$ CString -> Word32 -> Ptr (Ptr GError) -> IO (Ptr Dir)
g_dir_open CString
path' Word32
flags
        Text -> Ptr Dir -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dirOpen" Ptr Dir
result
        Dir
result' <- ((ManagedPtr Dir -> Dir) -> Ptr Dir -> IO Dir
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Dir -> Dir
Dir) Ptr Dir
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
        Dir -> IO Dir
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Dir
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Dir::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dir"
--           , argType = TInterface Name { namespace = "GLib" , name = "Dir" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDir* created by g_dir_open()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dir_close" g_dir_close :: 
    Ptr Dir ->                              -- dir : TInterface (Name {namespace = "GLib", name = "Dir"})
    IO ()

-- | Closes the directory immediately and decrements the reference count.
-- 
-- Once the reference count reaches zero, the @GDir@ structure itself will be
-- freed. Prior to GLib 2.80, @GDir@ was not reference counted.
-- 
-- It is an error to call any of the @GDir@ methods other than
-- 'GI.GLib.Structs.Dir.dirRef' and 'GI.GLib.Structs.Dir.dirUnref' on a @GDir@ after calling
-- 'GI.GLib.Structs.Dir.dirClose' on it.
dirClose ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dir
    -- ^ /@dir@/: a t'GI.GLib.Structs.Dir.Dir'* created by 'GI.GLib.Structs.Dir.dirOpen'
    -> m ()
dirClose :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Dir -> m ()
dirClose Dir
dir = 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 Dir
dir' <- Dir -> IO (Ptr Dir)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Dir
dir
    Ptr Dir -> IO ()
g_dir_close Ptr Dir
dir'
    Dir -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Dir
dir
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DirCloseMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DirCloseMethodInfo Dir signature where
    overloadedMethod = dirClose

instance O.OverloadedMethodInfo DirCloseMethodInfo Dir where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Dir.dirClose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Dir.html#v:dirClose"
        })


#endif

-- method Dir::read_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dir"
--           , argType = TInterface Name { namespace = "GLib" , name = "Dir" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDir* created by g_dir_open()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "g_dir_read_name" g_dir_read_name :: 
    Ptr Dir ->                              -- dir : TInterface (Name {namespace = "GLib", name = "Dir"})
    IO CString

-- | Retrieves the name of another entry in the directory, or 'P.Nothing'.
-- The order of entries returned from this function is not defined,
-- and may vary by file system or other operating-system dependent
-- factors.
-- 
-- 'P.Nothing' may also be returned in case of errors. On Unix, you can
-- check @errno@ to find out if 'P.Nothing' was returned because of an error.
-- 
-- On Unix, the \'.\' and \'..\' entries are omitted, and the returned
-- name is in the on-disk encoding.
-- 
-- On Windows, as is true of all GLib functions which operate on
-- filenames, the returned name is in UTF-8.
dirReadName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dir
    -- ^ /@dir@/: a t'GI.GLib.Structs.Dir.Dir'* created by 'GI.GLib.Structs.Dir.dirOpen'
    -> m [Char]
    -- ^ __Returns:__ The entry\'s name or 'P.Nothing' if there are no
    --   more entries. The return value is owned by GLib and
    --   must not be modified or freed.
dirReadName :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Dir -> m [Char]
dirReadName Dir
dir = IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dir
dir' <- Dir -> IO (Ptr Dir)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Dir
dir
    CString
result <- Ptr Dir -> IO CString
g_dir_read_name Ptr Dir
dir'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dirReadName" CString
result
    [Char]
result' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result
    Dir -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Dir
dir
    [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result'

#if defined(ENABLE_OVERLOADING)
data DirReadNameMethodInfo
instance (signature ~ (m [Char]), MonadIO m) => O.OverloadedMethod DirReadNameMethodInfo Dir signature where
    overloadedMethod = dirReadName

instance O.OverloadedMethodInfo DirReadNameMethodInfo Dir where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Dir.dirReadName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Dir.html#v:dirReadName"
        })


#endif

-- method Dir::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dir"
--           , argType = TInterface Name { namespace = "GLib" , name = "Dir" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GDir`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Dir" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dir_ref" g_dir_ref :: 
    Ptr Dir ->                              -- dir : TInterface (Name {namespace = "GLib", name = "Dir"})
    IO (Ptr Dir)

-- | Increment the reference count of @dir@.
-- 
-- /Since: 2.80/
dirRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dir
    -- ^ /@dir@/: a @GDir@
    -> m Dir
    -- ^ __Returns:__ the same pointer as @dir@
dirRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Dir -> m Dir
dirRef Dir
dir = IO Dir -> m Dir
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Dir -> m Dir) -> IO Dir -> m Dir
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dir
dir' <- Dir -> IO (Ptr Dir)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Dir
dir
    Ptr Dir
result <- Ptr Dir -> IO (Ptr Dir)
g_dir_ref Ptr Dir
dir'
    Text -> Ptr Dir -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dirRef" Ptr Dir
result
    Dir
result' <- ((ManagedPtr Dir -> Dir) -> Ptr Dir -> IO Dir
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Dir -> Dir
Dir) Ptr Dir
result
    Dir -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Dir
dir
    Dir -> IO Dir
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Dir
result'

#if defined(ENABLE_OVERLOADING)
data DirRefMethodInfo
instance (signature ~ (m Dir), MonadIO m) => O.OverloadedMethod DirRefMethodInfo Dir signature where
    overloadedMethod = dirRef

instance O.OverloadedMethodInfo DirRefMethodInfo Dir where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Dir.dirRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Dir.html#v:dirRef"
        })


#endif

-- method Dir::rewind
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dir"
--           , argType = TInterface Name { namespace = "GLib" , name = "Dir" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDir* created by g_dir_open()"
--                 , 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 "g_dir_rewind" g_dir_rewind :: 
    Ptr Dir ->                              -- dir : TInterface (Name {namespace = "GLib", name = "Dir"})
    IO ()

-- | Resets the given directory. The next call to 'GI.GLib.Structs.Dir.dirReadName'
-- will return the first entry again.
dirRewind ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dir
    -- ^ /@dir@/: a t'GI.GLib.Structs.Dir.Dir'* created by 'GI.GLib.Structs.Dir.dirOpen'
    -> m ()
dirRewind :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Dir -> m ()
dirRewind Dir
dir = 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 Dir
dir' <- Dir -> IO (Ptr Dir)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Dir
dir
    Ptr Dir -> IO ()
g_dir_rewind Ptr Dir
dir'
    Dir -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Dir
dir
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DirRewindMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DirRewindMethodInfo Dir signature where
    overloadedMethod = dirRewind

instance O.OverloadedMethodInfo DirRewindMethodInfo Dir where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Dir.dirRewind",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Dir.html#v:dirRewind"
        })


#endif

-- method Dir::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dir"
--           , argType = TInterface Name { namespace = "GLib" , name = "Dir" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GDir`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dir_unref" g_dir_unref :: 
    Ptr Dir ->                              -- dir : TInterface (Name {namespace = "GLib", name = "Dir"})
    IO ()

-- | Decrements the reference count of @dir@.
-- 
-- Once the reference count reaches zero, the directory will be closed and all
-- resources associated with it will be freed. If 'GI.GLib.Structs.Dir.dirClose' is
-- called when the reference count is greater than zero, the directory is closed
-- but the @GDir@ structure will not be freed until its reference count reaches
-- zero.
-- 
-- It is an error to call any of the @GDir@ methods other than
-- 'GI.GLib.Structs.Dir.dirRef' and 'GI.GLib.Structs.Dir.dirUnref' on a @GDir@ after calling
-- 'GI.GLib.Structs.Dir.dirClose' on it.
-- 
-- /Since: 2.80/
dirUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dir
    -- ^ /@dir@/: a @GDir@
    -> m ()
dirUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Dir -> m ()
dirUnref Dir
dir = 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 Dir
dir' <- Dir -> IO (Ptr Dir)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Dir
dir
    Ptr Dir -> IO ()
g_dir_unref Ptr Dir
dir'
    Dir -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Dir
dir
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DirUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DirUnrefMethodInfo Dir signature where
    overloadedMethod = dirUnref

instance O.OverloadedMethodInfo DirUnrefMethodInfo Dir where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Dir.dirUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Dir.html#v:dirUnref"
        })


#endif

-- method Dir::make_tmp
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "tmpl"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Template for directory name,\n  as in g_mkdtemp(), basename only, or %NULL for a default template"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : True
-- Skip return : False

foreign import ccall "g_dir_make_tmp" g_dir_make_tmp :: 
    CString ->                              -- tmpl : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Creates a subdirectory in the preferred directory for temporary
-- files (as returned by 'GI.GLib.Functions.getTmpDir').
-- 
-- /@tmpl@/ should be a string in the GLib file name encoding containing
-- a sequence of six \'X\' characters, as the parameter to @/g_mkstemp()/@.
-- However, unlike these functions, the template should only be a
-- basename, no directory components are allowed. If template is
-- 'P.Nothing', a default template is used.
-- 
-- Note that in contrast to @/g_mkdtemp()/@ (and @/mkdtemp()/@) /@tmpl@/ is not
-- modified, and might thus be a read-only literal string.
-- 
-- /Since: 2.30/
dirMakeTmp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([Char])
    -- ^ /@tmpl@/: Template for directory name,
    --   as in @/g_mkdtemp()/@, basename only, or 'P.Nothing' for a default template
    -> m [Char]
    -- ^ __Returns:__ The actual name used. This string
    --   should be freed with 'GI.GLib.Functions.free' when not needed any longer and is
    --   is in the GLib file name encoding. In case of errors, 'P.Nothing' is
    --   returned and /@error@/ will be set. /(Can throw 'Data.GI.Base.GError.GError')/
dirMakeTmp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Char] -> m [Char]
dirMakeTmp Maybe [Char]
tmpl = IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
    CString
maybeTmpl <- case Maybe [Char]
tmpl of
        Maybe [Char]
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just [Char]
jTmpl -> do
            CString
jTmpl' <- [Char] -> IO CString
stringToCString [Char]
jTmpl
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTmpl'
    IO [Char] -> IO () -> IO [Char]
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO CString
g_dir_make_tmp CString
maybeTmpl
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dirMakeTmp" CString
result
        [Char]
result' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTmpl
        [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTmpl
     )

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDirMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDirMethod "close" o = DirCloseMethodInfo
    ResolveDirMethod "readName" o = DirReadNameMethodInfo
    ResolveDirMethod "ref" o = DirRefMethodInfo
    ResolveDirMethod "rewind" o = DirRewindMethodInfo
    ResolveDirMethod "unref" o = DirUnrefMethodInfo
    ResolveDirMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif