{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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(..)                                 ,
    noDir                                   ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveDirMethod                        ,
#endif


-- ** close #method:close#

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


-- ** makeTmp #method:makeTmp#

    dirMakeTmp                              ,


-- ** readName #method:readName#

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


-- ** rewind #method:rewind#

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




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL


-- | Memory-managed wrapper type.
newtype Dir = Dir (ManagedPtr Dir)
    deriving (Dir -> Dir -> Bool
(Dir -> Dir -> Bool) -> (Dir -> Dir -> Bool) -> Eq Dir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dir -> Dir -> Bool
$c/= :: Dir -> Dir -> Bool
== :: Dir -> Dir -> Bool
$c== :: Dir -> Dir -> Bool
Eq)
-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance WrappedPtr Dir where
    wrappedPtrCalloc :: IO (Ptr Dir)
wrappedPtrCalloc = Ptr Dir -> IO (Ptr Dir)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Dir
forall a. Ptr a
nullPtr
    wrappedPtrCopy :: Dir -> IO Dir
wrappedPtrCopy = Dir -> IO Dir
forall (m :: * -> *) a. Monad m => a -> m a
return
    wrappedPtrFree :: Maybe (GDestroyNotify Dir)
wrappedPtrFree = Maybe (GDestroyNotify Dir)
forall a. Maybe a
Nothing

-- | A convenience alias for `Nothing` :: `Maybe` `Dir`.
noDir :: Maybe Dir
noDir :: Maybe Dir
noDir = Maybe Dir
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Dir
type instance O.AttributeList Dir = DirAttributeList
type DirAttributeList = ('[ ] :: [(Symbol, *)])
#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
--           , transfer = TransferNothing
--           }
--       ]
-- 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 and deallocates all related resources.
dirClose ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dir
    -- ^ /@dir@/: a t'GI.GLib.Structs.Dir.Dir'* created by @/g_dir_open()/@
    -> m ()
dirClose :: Dir -> m ()
dirClose dir :: Dir
dir = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dir
dir' <- Dir -> IO (Ptr Dir)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Dir
dir
    Ptr Dir -> IO ()
g_dir_close Ptr Dir
dir'
    Dir -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Dir
dir
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DirCloseMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DirCloseMethodInfo Dir signature where
    overloadedMethod = 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
--           , 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 @/g_dir_open()/@
    -> 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 :: Dir -> m [Char]
dirReadName dir :: Dir
dir = IO [Char] -> m [Char]
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 "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 (m :: * -> *) a. Monad m => a -> m a
return [Char]
result'

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

#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
--           , 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 @/g_dir_open()/@
    -> m ()
dirRewind :: Dir -> m ()
dirRewind dir :: Dir
dir = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

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

#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
--           , 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 :: Maybe [Char] -> m [Char]
dirMakeTmp tmpl :: Maybe [Char]
tmpl = IO [Char] -> m [Char]
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
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jTmpl :: [Char]
jTmpl -> do
            CString
jTmpl' <- [Char] -> IO CString
stringToCString [Char]
jTmpl
            CString -> IO CString
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 "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 (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 :: *) :: * where
    ResolveDirMethod "close" o = DirCloseMethodInfo
    ResolveDirMethod "readName" o = DirReadNameMethodInfo
    ResolveDirMethod "rewind" o = DirRewindMethodInfo
    ResolveDirMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDirMethod t Dir, O.MethodInfo 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

#endif