{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Filters files by name or mime type.
-- 
-- @GtkFileFilter@ can be used to restrict the files being shown in a
-- file chooser. Files can be filtered based on their name (with
-- 'GI.Gtk.Objects.FileFilter.fileFilterAddPattern' or 'GI.Gtk.Objects.FileFilter.fileFilterAddSuffix')
-- or on their mime type (with 'GI.Gtk.Objects.FileFilter.fileFilterAddMimeType').
-- 
-- Filtering by mime types handles aliasing and subclassing of mime
-- types; e.g. a filter for text\/plain also matches a file with mime
-- type application\/rtf, since application\/rtf is a subclass of
-- text\/plain. Note that @GtkFileFilter@ allows wildcards for the
-- subtype of a mime type, so you can e.g. filter for image\/\\*.
-- 
-- Normally, file filters are used by adding them to a file chooser
-- (see 'GI.Gtk.Objects.FileDialog.fileDialogSetFilters'), but it is also possible to
-- manually use a file filter on any t'GI.Gtk.Objects.FilterListModel.FilterListModel' containing
-- @GFileInfo@ objects.
-- 
-- = GtkFileFilter as GtkBuildable
-- 
-- The @GtkFileFilter@ implementation of the @GtkBuildable@ interface
-- supports adding rules using the @\<mime-types>@ and @\<patterns>@ and
-- @\<suffixes>@ elements and listing the rules within. Specifying a
-- @\<mime-type>@ or @\<pattern>@ or @\<suffix>@ has the same effect as
-- as calling
-- 'GI.Gtk.Objects.FileFilter.fileFilterAddMimeType' or
-- 'GI.Gtk.Objects.FileFilter.fileFilterAddPattern' or
-- 'GI.Gtk.Objects.FileFilter.fileFilterAddSuffix'.
-- 
-- An example of a UI definition fragment specifying @GtkFileFilter@
-- rules:
-- 
-- === /xml code/
-- ><object class="GtkFileFilter">
-- >  <property name="name" translatable="yes">Text and Images</property>
-- >  <mime-types>
-- >    <mime-type>text/plain</mime-type>
-- >    <mime-type>image/ *</mime-type>
-- >  </mime-types>
-- >  <patterns>
-- >    <pattern>*.txt</pattern>
-- >  </patterns>
-- >  <suffixes>
-- >    <suffix>png</suffix>
-- >  </suffixes>
-- ></object>
-- 

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

module GI.Gtk.Objects.FileFilter
    ( 

-- * Exported types
    FileFilter(..)                          ,
    IsFileFilter                            ,
    toFileFilter                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addMimeType]("GI.Gtk.Objects.FileFilter#g:method:addMimeType"), [addPattern]("GI.Gtk.Objects.FileFilter#g:method:addPattern"), [addPixbufFormats]("GI.Gtk.Objects.FileFilter#g:method:addPixbufFormats"), [addSuffix]("GI.Gtk.Objects.FileFilter#g:method:addSuffix"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [changed]("GI.Gtk.Objects.Filter#g:method:changed"), [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"), [match]("GI.Gtk.Objects.Filter#g:method:match"), [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"), [toGvariant]("GI.Gtk.Objects.FileFilter#g:method:toGvariant"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAttributes]("GI.Gtk.Objects.FileFilter#g:method:getAttributes"), [getBuildableId]("GI.Gtk.Interfaces.Buildable#g:method:getBuildableId"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getName]("GI.Gtk.Objects.FileFilter#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStrictness]("GI.Gtk.Objects.Filter#g:method:getStrictness").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setName]("GI.Gtk.Objects.FileFilter#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFileFilterMethod                 ,
#endif

-- ** addMimeType #method:addMimeType#

#if defined(ENABLE_OVERLOADING)
    FileFilterAddMimeTypeMethodInfo         ,
#endif
    fileFilterAddMimeType                   ,


-- ** addPattern #method:addPattern#

#if defined(ENABLE_OVERLOADING)
    FileFilterAddPatternMethodInfo          ,
#endif
    fileFilterAddPattern                    ,


-- ** addPixbufFormats #method:addPixbufFormats#

#if defined(ENABLE_OVERLOADING)
    FileFilterAddPixbufFormatsMethodInfo    ,
#endif
    fileFilterAddPixbufFormats              ,


-- ** addSuffix #method:addSuffix#

#if defined(ENABLE_OVERLOADING)
    FileFilterAddSuffixMethodInfo           ,
#endif
    fileFilterAddSuffix                     ,


-- ** getAttributes #method:getAttributes#

#if defined(ENABLE_OVERLOADING)
    FileFilterGetAttributesMethodInfo       ,
#endif
    fileFilterGetAttributes                 ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    FileFilterGetNameMethodInfo             ,
#endif
    fileFilterGetName                       ,


-- ** new #method:new#

    fileFilterNew                           ,


-- ** newFromGvariant #method:newFromGvariant#

    fileFilterNewFromGvariant               ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    FileFilterSetNameMethodInfo             ,
#endif
    fileFilterSetName                       ,


-- ** toGvariant #method:toGvariant#

#if defined(ENABLE_OVERLOADING)
    FileFilterToGvariantMethodInfo          ,
#endif
    fileFilterToGvariant                    ,




 -- * Properties


-- ** mimeTypes #attr:mimeTypes#
-- | The MIME types that this filter matches.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileFilterMimeTypesPropertyInfo         ,
#endif
    constructFileFilterMimeTypes            ,
#if defined(ENABLE_OVERLOADING)
    fileFilterMimeTypes                     ,
#endif


-- ** name #attr:name#
-- | The human-readable name of the filter.
-- 
-- This is the string that will be displayed in the user interface
-- if there is a selectable list of filters.

#if defined(ENABLE_OVERLOADING)
    FileFilterNamePropertyInfo              ,
#endif
    clearFileFilterName                     ,
    constructFileFilterName                 ,
#if defined(ENABLE_OVERLOADING)
    fileFilterName                          ,
#endif
    getFileFilterName                       ,
    setFileFilterName                       ,


-- ** patterns #attr:patterns#
-- | The patterns that this filter matches.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileFilterPatternsPropertyInfo          ,
#endif
    constructFileFilterPatterns             ,
#if defined(ENABLE_OVERLOADING)
    fileFilterPatterns                      ,
#endif


-- ** suffixes #attr:suffixes#
-- | The suffixes that this filter matches.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileFilterSuffixesPropertyInfo          ,
#endif
    constructFileFilterSuffixes             ,
#if defined(ENABLE_OVERLOADING)
    fileFilterSuffixes                      ,
#endif




    ) 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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Filter as Gtk.Filter

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Filter as Gtk.Filter

#endif

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

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

foreign import ccall "gtk_file_filter_get_type"
    c_gtk_file_filter_get_type :: IO B.Types.GType

instance B.Types.TypedObject FileFilter where
    glibType :: IO GType
glibType = IO GType
c_gtk_file_filter_get_type

instance B.Types.GObject FileFilter

-- | Type class for types which can be safely cast to t'FileFilter', for instance with `toFileFilter`.
class (SP.GObject o, O.IsDescendantOf FileFilter o) => IsFileFilter o
instance (SP.GObject o, O.IsDescendantOf FileFilter o) => IsFileFilter o

instance O.HasParentTypes FileFilter
type instance O.ParentTypes FileFilter = '[Gtk.Filter.Filter, GObject.Object.Object, Gtk.Buildable.Buildable]

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

-- | Convert t'FileFilter' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe FileFilter) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_file_filter_get_type
    gvalueSet_ :: Ptr GValue -> Maybe FileFilter -> IO ()
gvalueSet_ Ptr GValue
gv Maybe FileFilter
P.Nothing = Ptr GValue -> Ptr FileFilter -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr FileFilter
forall a. Ptr a
FP.nullPtr :: FP.Ptr FileFilter)
    gvalueSet_ Ptr GValue
gv (P.Just FileFilter
obj) = FileFilter -> (Ptr FileFilter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FileFilter
obj (Ptr GValue -> Ptr FileFilter -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe FileFilter)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr FileFilter)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr FileFilter)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject FileFilter ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveFileFilterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFileFilterMethod "addMimeType" o = FileFilterAddMimeTypeMethodInfo
    ResolveFileFilterMethod "addPattern" o = FileFilterAddPatternMethodInfo
    ResolveFileFilterMethod "addPixbufFormats" o = FileFilterAddPixbufFormatsMethodInfo
    ResolveFileFilterMethod "addSuffix" o = FileFilterAddSuffixMethodInfo
    ResolveFileFilterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFileFilterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFileFilterMethod "changed" o = Gtk.Filter.FilterChangedMethodInfo
    ResolveFileFilterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFileFilterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFileFilterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFileFilterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFileFilterMethod "match" o = Gtk.Filter.FilterMatchMethodInfo
    ResolveFileFilterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFileFilterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFileFilterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFileFilterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFileFilterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFileFilterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFileFilterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFileFilterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFileFilterMethod "toGvariant" o = FileFilterToGvariantMethodInfo
    ResolveFileFilterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFileFilterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFileFilterMethod "getAttributes" o = FileFilterGetAttributesMethodInfo
    ResolveFileFilterMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    ResolveFileFilterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFileFilterMethod "getName" o = FileFilterGetNameMethodInfo
    ResolveFileFilterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFileFilterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFileFilterMethod "getStrictness" o = Gtk.Filter.FilterGetStrictnessMethodInfo
    ResolveFileFilterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFileFilterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFileFilterMethod "setName" o = FileFilterSetNameMethodInfo
    ResolveFileFilterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFileFilterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "mime-types"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a t'GValueConstruct' with valid value for the “@mime-types@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileFilterMimeTypes :: (IsFileFilter o, MIO.MonadIO m) => [T.Text] -> m (GValueConstruct o)
constructFileFilterMimeTypes :: forall o (m :: * -> *).
(IsFileFilter o, MonadIO m) =>
[Text] -> m (GValueConstruct o)
constructFileFilterMimeTypes [Text]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe [Text] -> IO (GValueConstruct o)
forall o. String -> Maybe [Text] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyStringArray String
"mime-types" ([Text] -> Maybe [Text]
forall a. a -> Maybe a
P.Just [Text]
val)

#if defined(ENABLE_OVERLOADING)
data FileFilterMimeTypesPropertyInfo
instance AttrInfo FileFilterMimeTypesPropertyInfo where
    type AttrAllowedOps FileFilterMimeTypesPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint FileFilterMimeTypesPropertyInfo = IsFileFilter
    type AttrSetTypeConstraint FileFilterMimeTypesPropertyInfo = (~) [T.Text]
    type AttrTransferTypeConstraint FileFilterMimeTypesPropertyInfo = (~) [T.Text]
    type AttrTransferType FileFilterMimeTypesPropertyInfo = [T.Text]
    type AttrGetType FileFilterMimeTypesPropertyInfo = ()
    type AttrLabel FileFilterMimeTypesPropertyInfo = "mime-types"
    type AttrOrigin FileFilterMimeTypesPropertyInfo = FileFilter
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileFilterMimeTypes
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.mimeTypes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#g:attr:mimeTypes"
        })
#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileFilter [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileFilterName :: (MonadIO m, IsFileFilter o) => o -> T.Text -> m ()
setFileFilterName :: forall (m :: * -> *) o.
(MonadIO m, IsFileFilter o) =>
o -> Text -> m ()
setFileFilterName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a t'GValueConstruct' with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileFilterName :: (IsFileFilter o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructFileFilterName :: forall o (m :: * -> *).
(IsFileFilter o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructFileFilterName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@name@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearFileFilterName :: (MonadIO m, IsFileFilter o) => o -> m ()
clearFileFilterName :: forall (m :: * -> *) o. (MonadIO m, IsFileFilter o) => o -> m ()
clearFileFilterName o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data FileFilterNamePropertyInfo
instance AttrInfo FileFilterNamePropertyInfo where
    type AttrAllowedOps FileFilterNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileFilterNamePropertyInfo = IsFileFilter
    type AttrSetTypeConstraint FileFilterNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint FileFilterNamePropertyInfo = (~) T.Text
    type AttrTransferType FileFilterNamePropertyInfo = T.Text
    type AttrGetType FileFilterNamePropertyInfo = (Maybe T.Text)
    type AttrLabel FileFilterNamePropertyInfo = "name"
    type AttrOrigin FileFilterNamePropertyInfo = FileFilter
    attrGet = getFileFilterName
    attrSet = setFileFilterName
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileFilterName
    attrClear = clearFileFilterName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#g:attr:name"
        })
#endif

-- VVV Prop "patterns"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a t'GValueConstruct' with valid value for the “@patterns@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileFilterPatterns :: (IsFileFilter o, MIO.MonadIO m) => [T.Text] -> m (GValueConstruct o)
constructFileFilterPatterns :: forall o (m :: * -> *).
(IsFileFilter o, MonadIO m) =>
[Text] -> m (GValueConstruct o)
constructFileFilterPatterns [Text]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe [Text] -> IO (GValueConstruct o)
forall o. String -> Maybe [Text] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyStringArray String
"patterns" ([Text] -> Maybe [Text]
forall a. a -> Maybe a
P.Just [Text]
val)

#if defined(ENABLE_OVERLOADING)
data FileFilterPatternsPropertyInfo
instance AttrInfo FileFilterPatternsPropertyInfo where
    type AttrAllowedOps FileFilterPatternsPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint FileFilterPatternsPropertyInfo = IsFileFilter
    type AttrSetTypeConstraint FileFilterPatternsPropertyInfo = (~) [T.Text]
    type AttrTransferTypeConstraint FileFilterPatternsPropertyInfo = (~) [T.Text]
    type AttrTransferType FileFilterPatternsPropertyInfo = [T.Text]
    type AttrGetType FileFilterPatternsPropertyInfo = ()
    type AttrLabel FileFilterPatternsPropertyInfo = "patterns"
    type AttrOrigin FileFilterPatternsPropertyInfo = FileFilter
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileFilterPatterns
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.patterns"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#g:attr:patterns"
        })
#endif

-- VVV Prop "suffixes"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a t'GValueConstruct' with valid value for the “@suffixes@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileFilterSuffixes :: (IsFileFilter o, MIO.MonadIO m) => [T.Text] -> m (GValueConstruct o)
constructFileFilterSuffixes :: forall o (m :: * -> *).
(IsFileFilter o, MonadIO m) =>
[Text] -> m (GValueConstruct o)
constructFileFilterSuffixes [Text]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe [Text] -> IO (GValueConstruct o)
forall o. String -> Maybe [Text] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyStringArray String
"suffixes" ([Text] -> Maybe [Text]
forall a. a -> Maybe a
P.Just [Text]
val)

#if defined(ENABLE_OVERLOADING)
data FileFilterSuffixesPropertyInfo
instance AttrInfo FileFilterSuffixesPropertyInfo where
    type AttrAllowedOps FileFilterSuffixesPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint FileFilterSuffixesPropertyInfo = IsFileFilter
    type AttrSetTypeConstraint FileFilterSuffixesPropertyInfo = (~) [T.Text]
    type AttrTransferTypeConstraint FileFilterSuffixesPropertyInfo = (~) [T.Text]
    type AttrTransferType FileFilterSuffixesPropertyInfo = [T.Text]
    type AttrGetType FileFilterSuffixesPropertyInfo = ()
    type AttrLabel FileFilterSuffixesPropertyInfo = "suffixes"
    type AttrOrigin FileFilterSuffixesPropertyInfo = FileFilter
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileFilterSuffixes
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.suffixes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#g:attr:suffixes"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FileFilter
type instance O.AttributeList FileFilter = FileFilterAttributeList
type FileFilterAttributeList = ('[ '("mimeTypes", FileFilterMimeTypesPropertyInfo), '("name", FileFilterNamePropertyInfo), '("patterns", FileFilterPatternsPropertyInfo), '("suffixes", FileFilterSuffixesPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
fileFilterMimeTypes :: AttrLabelProxy "mimeTypes"
fileFilterMimeTypes = AttrLabelProxy

fileFilterName :: AttrLabelProxy "name"
fileFilterName = AttrLabelProxy

fileFilterPatterns :: AttrLabelProxy "patterns"
fileFilterPatterns = AttrLabelProxy

fileFilterSuffixes :: AttrLabelProxy "suffixes"
fileFilterSuffixes = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList FileFilter = FileFilterSignalList
type FileFilterSignalList = ('[ '("changed", Gtk.Filter.FilterChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method FileFilter::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "FileFilter" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_filter_new" gtk_file_filter_new :: 
    IO (Ptr FileFilter)

-- | Creates a new @GtkFileFilter@ with no rules added to it.
-- 
-- Such a filter doesn’t accept any files, so is not
-- particularly useful until you add rules with
-- 'GI.Gtk.Objects.FileFilter.fileFilterAddMimeType',
-- 'GI.Gtk.Objects.FileFilter.fileFilterAddPattern',
-- 'GI.Gtk.Objects.FileFilter.fileFilterAddSuffix' or
-- 'GI.Gtk.Objects.FileFilter.fileFilterAddPixbufFormats'.
-- 
-- To create a filter that accepts any file, use:
-- 
-- === /c code/
-- >GtkFileFilter *filter = gtk_file_filter_new ();
-- >gtk_file_filter_add_pattern (filter, "*");
fileFilterNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FileFilter
    -- ^ __Returns:__ a new @GtkFileFilter@
fileFilterNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m FileFilter
fileFilterNew  = IO FileFilter -> m FileFilter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileFilter -> m FileFilter) -> IO FileFilter -> m FileFilter
forall a b. (a -> b) -> a -> b
$ do
    result <- IO (Ptr FileFilter)
gtk_file_filter_new
    checkUnexpectedReturnNULL "fileFilterNew" result
    result' <- (wrapObject FileFilter) result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FileFilter::new_from_gvariant
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "variant"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an `a{sv}` `GVariant`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "FileFilter" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_filter_new_from_gvariant" gtk_file_filter_new_from_gvariant :: 
    Ptr GVariant ->                         -- variant : TVariant
    IO (Ptr FileFilter)

-- | Deserialize a file filter from a @GVariant@.
-- 
-- The variant must be in the format produced by
-- 'GI.Gtk.Objects.FileFilter.fileFilterToGvariant'.
fileFilterNewFromGvariant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GVariant
    -- ^ /@variant@/: an @a{sv}@ @GVariant@
    -> m FileFilter
    -- ^ __Returns:__ a new @GtkFileFilter@ object
fileFilterNewFromGvariant :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GVariant -> m FileFilter
fileFilterNewFromGvariant GVariant
variant = IO FileFilter -> m FileFilter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileFilter -> m FileFilter) -> IO FileFilter -> m FileFilter
forall a b. (a -> b) -> a -> b
$ do
    variant' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
variant
    result <- gtk_file_filter_new_from_gvariant variant'
    checkUnexpectedReturnNULL "fileFilterNewFromGvariant" result
    result' <- (wrapObject FileFilter) result
    touchManagedPtr variant
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FileFilter::add_mime_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A file filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of a MIME type"
--                 , 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 "gtk_file_filter_add_mime_type" gtk_file_filter_add_mime_type :: 
    Ptr FileFilter ->                       -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    CString ->                              -- mime_type : TBasicType TUTF8
    IO ()

-- | Adds a rule allowing a given mime type.
fileFilterAddMimeType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileFilter a) =>
    a
    -- ^ /@filter@/: A file filter
    -> T.Text
    -- ^ /@mimeType@/: name of a MIME type
    -> m ()
fileFilterAddMimeType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileFilter a) =>
a -> Text -> m ()
fileFilterAddMimeType a
filter Text
mimeType = 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
    filter' <- a -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
filter
    mimeType' <- textToCString mimeType
    gtk_file_filter_add_mime_type filter' mimeType'
    touchManagedPtr filter
    freeMem mimeType'
    return ()

#if defined(ENABLE_OVERLOADING)
data FileFilterAddMimeTypeMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsFileFilter a) => O.OverloadedMethod FileFilterAddMimeTypeMethodInfo a signature where
    overloadedMethod = fileFilterAddMimeType

instance O.OverloadedMethodInfo FileFilterAddMimeTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.fileFilterAddMimeType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#v:fileFilterAddMimeType"
        })


#endif

-- method FileFilter::add_pattern
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pattern"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a shell style glob pattern"
--                 , 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 "gtk_file_filter_add_pattern" gtk_file_filter_add_pattern :: 
    Ptr FileFilter ->                       -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    CString ->                              -- pattern : TBasicType TUTF8
    IO ()

-- | Adds a rule allowing a shell style glob pattern.
-- 
-- Note that it depends on the platform whether pattern
-- matching ignores case or not. On Windows, it does, on
-- other platforms, it doesn\'t.
fileFilterAddPattern ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileFilter a) =>
    a
    -- ^ /@filter@/: a file filter
    -> T.Text
    -- ^ /@pattern@/: a shell style glob pattern
    -> m ()
fileFilterAddPattern :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileFilter a) =>
a -> Text -> m ()
fileFilterAddPattern a
filter Text
pattern = 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
    filter' <- a -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
filter
    pattern' <- textToCString pattern
    gtk_file_filter_add_pattern filter' pattern'
    touchManagedPtr filter
    freeMem pattern'
    return ()

#if defined(ENABLE_OVERLOADING)
data FileFilterAddPatternMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsFileFilter a) => O.OverloadedMethod FileFilterAddPatternMethodInfo a signature where
    overloadedMethod = fileFilterAddPattern

instance O.OverloadedMethodInfo FileFilterAddPatternMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.fileFilterAddPattern",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#v:fileFilterAddPattern"
        })


#endif

-- method FileFilter::add_pixbuf_formats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file filter" , 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 "gtk_file_filter_add_pixbuf_formats" gtk_file_filter_add_pixbuf_formats :: 
    Ptr FileFilter ->                       -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    IO ()

-- | Adds a rule allowing image files in the formats supported by @GdkPixbuf@.
-- 
-- This is equivalent to calling 'GI.Gtk.Objects.FileFilter.fileFilterAddMimeType'
-- for all the supported mime types.
fileFilterAddPixbufFormats ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileFilter a) =>
    a
    -- ^ /@filter@/: a file filter
    -> m ()
fileFilterAddPixbufFormats :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileFilter a) =>
a -> m ()
fileFilterAddPixbufFormats a
filter = 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
    filter' <- a -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
filter
    gtk_file_filter_add_pixbuf_formats filter'
    touchManagedPtr filter
    return ()

#if defined(ENABLE_OVERLOADING)
data FileFilterAddPixbufFormatsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsFileFilter a) => O.OverloadedMethod FileFilterAddPixbufFormatsMethodInfo a signature where
    overloadedMethod = fileFilterAddPixbufFormats

instance O.OverloadedMethodInfo FileFilterAddPixbufFormatsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.fileFilterAddPixbufFormats",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#v:fileFilterAddPixbufFormats"
        })


#endif

-- method FileFilter::add_suffix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "suffix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "filename suffix to match"
--                 , 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 "gtk_file_filter_add_suffix" gtk_file_filter_add_suffix :: 
    Ptr FileFilter ->                       -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    CString ->                              -- suffix : TBasicType TUTF8
    IO ()

-- | Adds a suffix match rule to a filter.
-- 
-- This is similar to adding a match for the pattern \"*./@suffix@/\"
-- 
-- An exaple to filter files with the suffix \".sub\":
-- 
-- === /c code/
-- >gtk_file_filter_add_suffix (filter, "sub");
-- 
-- 
-- Filters with multiple dots are allowed.
-- 
-- In contrast to pattern matches, suffix matches
-- are *always* case-insensitive.
-- 
-- /Since: 4.4/
fileFilterAddSuffix ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileFilter a) =>
    a
    -- ^ /@filter@/: a file filter
    -> T.Text
    -- ^ /@suffix@/: filename suffix to match
    -> m ()
fileFilterAddSuffix :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileFilter a) =>
a -> Text -> m ()
fileFilterAddSuffix a
filter Text
suffix = 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
    filter' <- a -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
filter
    suffix' <- textToCString suffix
    gtk_file_filter_add_suffix filter' suffix'
    touchManagedPtr filter
    freeMem suffix'
    return ()

#if defined(ENABLE_OVERLOADING)
data FileFilterAddSuffixMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsFileFilter a) => O.OverloadedMethod FileFilterAddSuffixMethodInfo a signature where
    overloadedMethod = fileFilterAddSuffix

instance O.OverloadedMethodInfo FileFilterAddSuffixMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.fileFilterAddSuffix",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#v:fileFilterAddSuffix"
        })


#endif

-- method FileFilter::get_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_filter_get_attributes" gtk_file_filter_get_attributes :: 
    Ptr FileFilter ->                       -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    IO (Ptr CString)

-- | Gets the attributes that need to be filled in for the @GFileInfo@
-- passed to this filter.
-- 
-- This function will not typically be used by applications;
-- it is intended for use in file chooser implementation.
fileFilterGetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileFilter a) =>
    a
    -- ^ /@filter@/: a file filter
    -> m [T.Text]
    -- ^ __Returns:__ the attributes
fileFilterGetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileFilter a) =>
a -> m [Text]
fileFilterGetAttributes a
filter = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    filter' <- a -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
filter
    result <- gtk_file_filter_get_attributes filter'
    checkUnexpectedReturnNULL "fileFilterGetAttributes" result
    result' <- unpackZeroTerminatedUTF8CArray result
    touchManagedPtr filter
    return result'

#if defined(ENABLE_OVERLOADING)
data FileFilterGetAttributesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsFileFilter a) => O.OverloadedMethod FileFilterGetAttributesMethodInfo a signature where
    overloadedMethod = fileFilterGetAttributes

instance O.OverloadedMethodInfo FileFilterGetAttributesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.fileFilterGetAttributes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#v:fileFilterGetAttributes"
        })


#endif

-- method FileFilter::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_filter_get_name" gtk_file_filter_get_name :: 
    Ptr FileFilter ->                       -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    IO CString

-- | Gets the human-readable name for the filter.
-- 
-- See 'GI.Gtk.Objects.FileFilter.fileFilterSetName'.
fileFilterGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileFilter a) =>
    a
    -- ^ /@filter@/: a file filter
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the human-readable name of the filter
fileFilterGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileFilter a) =>
a -> m (Maybe Text)
fileFilterGetName a
filter = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    filter' <- a -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
filter
    result <- gtk_file_filter_get_name filter'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr filter
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data FileFilterGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsFileFilter a) => O.OverloadedMethod FileFilterGetNameMethodInfo a signature where
    overloadedMethod = fileFilterGetName

instance O.OverloadedMethodInfo FileFilterGetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.fileFilterGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#v:fileFilterGetName"
        })


#endif

-- method FileFilter::set_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the human-readable name for the filter"
--                 , 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 "gtk_file_filter_set_name" gtk_file_filter_set_name :: 
    Ptr FileFilter ->                       -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Sets a human-readable name of the filter.
-- 
-- This is the string that will be displayed in the user interface
-- if there is a selectable list of filters.
fileFilterSetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileFilter a) =>
    a
    -- ^ /@filter@/: a file filter
    -> Maybe (T.Text)
    -- ^ /@name@/: the human-readable name for the filter
    -> m ()
fileFilterSetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileFilter a) =>
a -> Maybe Text -> m ()
fileFilterSetName a
filter Maybe Text
name = 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
    filter' <- a -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
filter
    maybeName <- case name of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jName -> do
            jName' <- Text -> IO CString
textToCString Text
jName
            return jName'
    gtk_file_filter_set_name filter' maybeName
    touchManagedPtr filter
    freeMem maybeName
    return ()

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

instance O.OverloadedMethodInfo FileFilterSetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.fileFilterSetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#v:fileFilterSetName"
        })


#endif

-- method FileFilter::to_gvariant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_filter_to_gvariant" gtk_file_filter_to_gvariant :: 
    Ptr FileFilter ->                       -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    IO (Ptr GVariant)

-- | Serialize a file filter to an @a{sv}@ variant.
fileFilterToGvariant ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileFilter a) =>
    a
    -- ^ /@filter@/: a file filter
    -> m GVariant
    -- ^ __Returns:__ a new, floating, @GVariant@
fileFilterToGvariant :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileFilter a) =>
a -> m GVariant
fileFilterToGvariant a
filter = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    filter' <- a -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
filter
    result <- gtk_file_filter_to_gvariant filter'
    checkUnexpectedReturnNULL "fileFilterToGvariant" result
    result' <- B.GVariant.newGVariantFromPtr result
    touchManagedPtr filter
    return result'

#if defined(ENABLE_OVERLOADING)
data FileFilterToGvariantMethodInfo
instance (signature ~ (m GVariant), MonadIO m, IsFileFilter a) => O.OverloadedMethod FileFilterToGvariantMethodInfo a signature where
    overloadedMethod = fileFilterToGvariant

instance O.OverloadedMethodInfo FileFilterToGvariantMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileFilter.fileFilterToGvariant",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileFilter.html#v:fileFilterToGvariant"
        })


#endif