{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An opaque type representing a list of files.
-- 
-- /Since: 4.6/

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

module GI.Gdk.Structs.FileList
    ( 

-- * Exported types
    FileList(..)                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- /None/.
-- 
-- ==== Getters
-- [getFiles]("GI.Gdk.Structs.FileList#g:method:getFiles").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveFileListMethod                   ,
#endif

-- ** getFiles #method:getFiles#

#if defined(ENABLE_OVERLOADING)
    FileListGetFilesMethodInfo              ,
#endif
    fileListGetFiles                        ,


-- ** newFromArray #method:newFromArray#

    fileListNewFromArray                    ,


-- ** newFromList #method:newFromList#

    fileListNewFromList                     ,




    ) 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.Gio.Interfaces.File as Gio.File

#else
import qualified GI.Gio.Interfaces.File as Gio.File

#endif

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

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

foreign import ccall "gdk_file_list_get_type" c_gdk_file_list_get_type :: 
    IO GType

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

instance B.Types.TypedObject FileList where
    glibType :: IO GType
glibType = IO GType
c_gdk_file_list_get_type

instance B.Types.GBoxed FileList

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


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

-- method FileList::new_from_array
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "files"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "Gio" , name = "File" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the files to add to the list"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_files"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of files in the array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_files"
--              , argType = TBasicType TSize
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of files in the array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "FileList" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_file_list_new_from_array" gdk_file_list_new_from_array :: 
    Ptr (Ptr Gio.File.File) ->              -- files : TCArray False (-1) 1 (TInterface (Name {namespace = "Gio", name = "File"}))
    FCT.CSize ->                            -- n_files : TBasicType TSize
    IO (Ptr FileList)

-- | Creates a new @GdkFileList@ for the given array of files.
-- 
-- This function is meant to be used by language bindings.
-- 
-- /Since: 4.8/
fileListNewFromArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Gio.File.File]
    -- ^ /@files@/: the files to add to the list
    -> m FileList
    -- ^ __Returns:__ the newly create files list
fileListNewFromArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[File] -> m FileList
fileListNewFromArray [File]
files = IO FileList -> m FileList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileList -> m FileList) -> IO FileList -> m FileList
forall a b. (a -> b) -> a -> b
$ do
    let nFiles :: CSize
nFiles = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ [File] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [File]
files
    [Ptr File]
files' <- (File -> IO (Ptr File)) -> [File] -> IO [Ptr File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM File -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [File]
files
    Ptr (Ptr File)
files'' <- [Ptr File] -> IO (Ptr (Ptr File))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr File]
files'
    Ptr FileList
result <- Ptr (Ptr File) -> CSize -> IO (Ptr FileList)
gdk_file_list_new_from_array Ptr (Ptr File)
files'' CSize
nFiles
    Text -> Ptr FileList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileListNewFromArray" Ptr FileList
result
    FileList
result' <- ((ManagedPtr FileList -> FileList) -> Ptr FileList -> IO FileList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FileList -> FileList
FileList) Ptr FileList
result
    (File -> IO ()) -> [File] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ File -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [File]
files
    Ptr (Ptr File) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr File)
files''
    FileList -> IO FileList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileList
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FileList::new_from_list
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "files"
--           , argType =
--               TGSList (TInterface Name { namespace = "Gio" , name = "File" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a list of files" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "FileList" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_file_list_new_from_list" gdk_file_list_new_from_list :: 
    Ptr (GSList (Ptr Gio.File.File)) ->     -- files : TGSList (TInterface (Name {namespace = "Gio", name = "File"}))
    IO (Ptr FileList)

-- | Creates a new files list container from a singly linked list of
-- @GFile@ instances.
-- 
-- This function is meant to be used by language bindings
-- 
-- /Since: 4.8/
fileListNewFromList ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    [a]
    -- ^ /@files@/: a list of files
    -> m FileList
    -- ^ __Returns:__ the newly created files list
fileListNewFromList :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
[a] -> m FileList
fileListNewFromList [a]
files = IO FileList -> m FileList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileList -> m FileList) -> IO FileList -> m FileList
forall a b. (a -> b) -> a -> b
$ do
    [Ptr File]
files' <- (a -> IO (Ptr File)) -> [a] -> IO [Ptr File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
files
    Ptr (GSList (Ptr File))
files'' <- [Ptr File] -> IO (Ptr (GSList (Ptr File)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr File]
files'
    Ptr FileList
result <- Ptr (GSList (Ptr File)) -> IO (Ptr FileList)
gdk_file_list_new_from_list Ptr (GSList (Ptr File))
files''
    Text -> Ptr FileList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileListNewFromList" Ptr FileList
result
    FileList
result' <- ((ManagedPtr FileList -> FileList) -> Ptr FileList -> IO FileList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FileList -> FileList
FileList) Ptr FileList
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
files
    Ptr (GSList (Ptr File)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr File))
files''
    FileList -> IO FileList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileList
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FileList::get_files
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file_list"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "FileList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the file list" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGSList (TInterface Name { namespace = "Gio" , name = "File" }))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_file_list_get_files" gdk_file_list_get_files :: 
    Ptr FileList ->                         -- file_list : TInterface (Name {namespace = "Gdk", name = "FileList"})
    IO (Ptr (GSList (Ptr Gio.File.File)))

-- | Retrieves the list of files inside a @GdkFileList@.
-- 
-- This function is meant for language bindings.
-- 
-- /Since: 4.6/
fileListGetFiles ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FileList
    -- ^ /@fileList@/: the file list
    -> m [Gio.File.File]
    -- ^ __Returns:__ the files inside the list
fileListGetFiles :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FileList -> m [File]
fileListGetFiles FileList
fileList = 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 FileList
fileList' <- FileList -> IO (Ptr FileList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FileList
fileList
    Ptr (GSList (Ptr File))
result <- Ptr FileList -> IO (Ptr (GSList (Ptr File)))
gdk_file_list_get_files Ptr FileList
fileList'
    [Ptr File]
result' <- Ptr (GSList (Ptr File)) -> IO [Ptr File]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr File))
result
    [File]
result'' <- (Ptr File -> IO File) -> [Ptr File] -> IO [File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((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'
    Ptr (GSList (Ptr File)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr File))
result
    FileList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FileList
fileList
    [File] -> IO [File]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [File]
result''

#if defined(ENABLE_OVERLOADING)
data FileListGetFilesMethodInfo
instance (signature ~ (m [Gio.File.File]), MonadIO m) => O.OverloadedMethod FileListGetFilesMethodInfo FileList signature where
    overloadedMethod = fileListGetFiles

instance O.OverloadedMethodInfo FileListGetFilesMethodInfo FileList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.FileList.fileListGetFiles",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.8/docs/GI-Gdk-Structs-FileList.html#v:fileListGetFiles"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFileListMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFileListMethod "getFiles" o = FileListGetFilesMethodInfo
    ResolveFileListMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif