{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GZlibCompressor@ is an implementation of t'GI.Gio.Interfaces.Converter.Converter' that
-- compresses data using zlib.

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

module GI.Gio.Objects.ZlibCompressor
    ( 

-- * Exported types
    ZlibCompressor(..)                      ,
    IsZlibCompressor                        ,
    toZlibCompressor                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [convert]("GI.Gio.Interfaces.Converter#g:method:convert"), [convertBytes]("GI.Gio.Interfaces.Converter#g:method:convertBytes"), [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"), [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"), [reset]("GI.Gio.Interfaces.Converter#g:method:reset"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFileInfo]("GI.Gio.Objects.ZlibCompressor#g:method:getFileInfo"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFileInfo]("GI.Gio.Objects.ZlibCompressor#g:method:setFileInfo"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveZlibCompressorMethod             ,
#endif

-- ** getFileInfo #method:getFileInfo#

#if defined(ENABLE_OVERLOADING)
    ZlibCompressorGetFileInfoMethodInfo     ,
#endif
    zlibCompressorGetFileInfo               ,


-- ** new #method:new#

    zlibCompressorNew                       ,


-- ** setFileInfo #method:setFileInfo#

#if defined(ENABLE_OVERLOADING)
    ZlibCompressorSetFileInfoMethodInfo     ,
#endif
    zlibCompressorSetFileInfo               ,




 -- * Properties


-- ** fileInfo #attr:fileInfo#
-- | If set to a non-'P.Nothing' t'GI.Gio.Objects.FileInfo.FileInfo' object, and [ZlibCompressor:format]("GI.Gio.Objects.ZlibCompressor#g:attr:format") is
-- 'GI.Gio.Enums.ZlibCompressorFormatGzip', the compressor will write the file name
-- and modification time from the file info to the GZIP header.
-- 
-- /Since: 2.26/

#if defined(ENABLE_OVERLOADING)
    ZlibCompressorFileInfoPropertyInfo      ,
#endif
    clearZlibCompressorFileInfo             ,
    constructZlibCompressorFileInfo         ,
    getZlibCompressorFileInfo               ,
    setZlibCompressorFileInfo               ,
#if defined(ENABLE_OVERLOADING)
    zlibCompressorFileInfo                  ,
#endif


-- ** format #attr:format#
-- | The format of the compressed data.
-- 
-- /Since: 2.24/

#if defined(ENABLE_OVERLOADING)
    ZlibCompressorFormatPropertyInfo        ,
#endif
    constructZlibCompressorFormat           ,
    getZlibCompressorFormat                 ,
#if defined(ENABLE_OVERLOADING)
    zlibCompressorFormat                    ,
#endif


-- ** level #attr:level#
-- | The level of compression from @0@ (no compression) to @9@ (most
-- compression). @-1@ for the default level.
-- 
-- /Since: 2.24/

#if defined(ENABLE_OVERLOADING)
    ZlibCompressorLevelPropertyInfo         ,
#endif
    constructZlibCompressorLevel            ,
    getZlibCompressorLevel                  ,
#if defined(ENABLE_OVERLOADING)
    zlibCompressorLevel                     ,
#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.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GLib.Structs.TimeVal as GLib.TimeVal
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Converter as Gio.Converter
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Icon as Gio.Icon
import {-# SOURCE #-} qualified GI.Gio.Objects.FileInfo as Gio.FileInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.FileAttributeMatcher as Gio.FileAttributeMatcher

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Converter as Gio.Converter
import {-# SOURCE #-} qualified GI.Gio.Objects.FileInfo as Gio.FileInfo

#endif

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

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

foreign import ccall "g_zlib_compressor_get_type"
    c_g_zlib_compressor_get_type :: IO B.Types.GType

instance B.Types.TypedObject ZlibCompressor where
    glibType :: IO GType
glibType = IO GType
c_g_zlib_compressor_get_type

instance B.Types.GObject ZlibCompressor

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

instance O.HasParentTypes ZlibCompressor
type instance O.ParentTypes ZlibCompressor = '[GObject.Object.Object, Gio.Converter.Converter]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveZlibCompressorMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveZlibCompressorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveZlibCompressorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveZlibCompressorMethod "convert" o = Gio.Converter.ConverterConvertMethodInfo
    ResolveZlibCompressorMethod "convertBytes" o = Gio.Converter.ConverterConvertBytesMethodInfo
    ResolveZlibCompressorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveZlibCompressorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveZlibCompressorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveZlibCompressorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveZlibCompressorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveZlibCompressorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveZlibCompressorMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveZlibCompressorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveZlibCompressorMethod "reset" o = Gio.Converter.ConverterResetMethodInfo
    ResolveZlibCompressorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveZlibCompressorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveZlibCompressorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveZlibCompressorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveZlibCompressorMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveZlibCompressorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveZlibCompressorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveZlibCompressorMethod "getFileInfo" o = ZlibCompressorGetFileInfoMethodInfo
    ResolveZlibCompressorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveZlibCompressorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveZlibCompressorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveZlibCompressorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveZlibCompressorMethod "setFileInfo" o = ZlibCompressorSetFileInfoMethodInfo
    ResolveZlibCompressorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveZlibCompressorMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveZlibCompressorMethod t ZlibCompressor, O.OverloadedMethod info ZlibCompressor p) => OL.IsLabel t (ZlibCompressor -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel :: ZlibCompressor -> p
fromLabel = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveZlibCompressorMethod t ZlibCompressor, O.OverloadedMethod info ZlibCompressor p, R.HasField t ZlibCompressor p) => R.HasField t ZlibCompressor p where
    getField :: ZlibCompressor -> p
getField = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info

#endif

instance (info ~ ResolveZlibCompressorMethod t ZlibCompressor, O.OverloadedMethodInfo info ZlibCompressor) => OL.IsLabel t (O.MethodProxy info ZlibCompressor) where
#if MIN_VERSION_base(4,10,0)
    fromLabel :: MethodProxy info ZlibCompressor
fromLabel = MethodProxy info ZlibCompressor
forall info obj. MethodProxy info obj
O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- VVV Prop "file-info"
   -- Type: TInterface (Name {namespace = "Gio", name = "FileInfo"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@file-info@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' zlibCompressor #fileInfo
-- @
getZlibCompressorFileInfo :: (MonadIO m, IsZlibCompressor o) => o -> m (Maybe Gio.FileInfo.FileInfo)
getZlibCompressorFileInfo :: forall (m :: * -> *) o.
(MonadIO m, IsZlibCompressor o) =>
o -> m (Maybe FileInfo)
getZlibCompressorFileInfo o
obj = IO (Maybe FileInfo) -> m (Maybe FileInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe FileInfo) -> m (Maybe FileInfo))
-> IO (Maybe FileInfo) -> m (Maybe FileInfo)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr FileInfo -> FileInfo)
-> IO (Maybe FileInfo)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"file-info" ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo

-- | Set the value of the “@file-info@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' zlibCompressor [ #fileInfo 'Data.GI.Base.Attributes.:=' value ]
-- @
setZlibCompressorFileInfo :: (MonadIO m, IsZlibCompressor o, Gio.FileInfo.IsFileInfo a) => o -> a -> m ()
setZlibCompressorFileInfo :: forall (m :: * -> *) o a.
(MonadIO m, IsZlibCompressor o, IsFileInfo a) =>
o -> a -> m ()
setZlibCompressorFileInfo o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"file-info" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@file-info@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructZlibCompressorFileInfo :: (IsZlibCompressor o, MIO.MonadIO m, Gio.FileInfo.IsFileInfo a) => a -> m (GValueConstruct o)
constructZlibCompressorFileInfo :: forall o (m :: * -> *) a.
(IsZlibCompressor o, MonadIO m, IsFileInfo a) =>
a -> m (GValueConstruct o)
constructZlibCompressorFileInfo a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"file-info" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@file-info@” 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' #fileInfo
-- @
clearZlibCompressorFileInfo :: (MonadIO m, IsZlibCompressor o) => o -> m ()
clearZlibCompressorFileInfo :: forall (m :: * -> *) o.
(MonadIO m, IsZlibCompressor o) =>
o -> m ()
clearZlibCompressorFileInfo 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 FileInfo -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"file-info" (Maybe FileInfo
forall a. Maybe a
Nothing :: Maybe Gio.FileInfo.FileInfo)

#if defined(ENABLE_OVERLOADING)
data ZlibCompressorFileInfoPropertyInfo
instance AttrInfo ZlibCompressorFileInfoPropertyInfo where
    type AttrAllowedOps ZlibCompressorFileInfoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ZlibCompressorFileInfoPropertyInfo = IsZlibCompressor
    type AttrSetTypeConstraint ZlibCompressorFileInfoPropertyInfo = Gio.FileInfo.IsFileInfo
    type AttrTransferTypeConstraint ZlibCompressorFileInfoPropertyInfo = Gio.FileInfo.IsFileInfo
    type AttrTransferType ZlibCompressorFileInfoPropertyInfo = Gio.FileInfo.FileInfo
    type AttrGetType ZlibCompressorFileInfoPropertyInfo = (Maybe Gio.FileInfo.FileInfo)
    type AttrLabel ZlibCompressorFileInfoPropertyInfo = "file-info"
    type AttrOrigin ZlibCompressorFileInfoPropertyInfo = ZlibCompressor
    attrGet :: forall o.
AttrBaseTypeConstraint ZlibCompressorFileInfoPropertyInfo o =>
o -> IO (AttrGetType ZlibCompressorFileInfoPropertyInfo)
attrGet = o -> IO (Maybe FileInfo)
o -> IO (AttrGetType ZlibCompressorFileInfoPropertyInfo)
forall (m :: * -> *) o.
(MonadIO m, IsZlibCompressor o) =>
o -> m (Maybe FileInfo)
getZlibCompressorFileInfo
    attrSet :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorFileInfoPropertyInfo o,
 AttrSetTypeConstraint ZlibCompressorFileInfoPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall (m :: * -> *) o a.
(MonadIO m, IsZlibCompressor o, IsFileInfo a) =>
o -> a -> m ()
setZlibCompressorFileInfo
    attrTransfer :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorFileInfoPropertyInfo o,
 AttrTransferTypeConstraint ZlibCompressorFileInfoPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType ZlibCompressorFileInfoPropertyInfo)
attrTransfer Proxy o
_ b
v = do
        (ManagedPtr FileInfo -> FileInfo) -> b -> IO FileInfo
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo b
v
    attrConstruct :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorFileInfoPropertyInfo o,
 AttrSetTypeConstraint ZlibCompressorFileInfoPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall o (m :: * -> *) a.
(IsZlibCompressor o, MonadIO m, IsFileInfo a) =>
a -> m (GValueConstruct o)
constructZlibCompressorFileInfo
    attrClear :: forall o.
AttrBaseTypeConstraint ZlibCompressorFileInfoPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall (m :: * -> *) o.
(MonadIO m, IsZlibCompressor o) =>
o -> m ()
clearZlibCompressorFileInfo
    dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ZlibCompressor.fileInfo"
        , resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ZlibCompressor.html#g:attr:fileInfo"
        })
#endif

-- VVV Prop "format"
   -- Type: TInterface (Name {namespace = "Gio", name = "ZlibCompressorFormat"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@format@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' zlibCompressor #format
-- @
getZlibCompressorFormat :: (MonadIO m, IsZlibCompressor o) => o -> m Gio.Enums.ZlibCompressorFormat
getZlibCompressorFormat :: forall (m :: * -> *) o.
(MonadIO m, IsZlibCompressor o) =>
o -> m ZlibCompressorFormat
getZlibCompressorFormat o
obj = IO ZlibCompressorFormat -> m ZlibCompressorFormat
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ZlibCompressorFormat -> m ZlibCompressorFormat)
-> IO ZlibCompressorFormat -> m ZlibCompressorFormat
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ZlibCompressorFormat
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"format"

-- | Construct a t'GValueConstruct' with valid value for the “@format@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructZlibCompressorFormat :: (IsZlibCompressor o, MIO.MonadIO m) => Gio.Enums.ZlibCompressorFormat -> m (GValueConstruct o)
constructZlibCompressorFormat :: forall o (m :: * -> *).
(IsZlibCompressor o, MonadIO m) =>
ZlibCompressorFormat -> m (GValueConstruct o)
constructZlibCompressorFormat ZlibCompressorFormat
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 -> ZlibCompressorFormat -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"format" ZlibCompressorFormat
val

#if defined(ENABLE_OVERLOADING)
data ZlibCompressorFormatPropertyInfo
instance AttrInfo ZlibCompressorFormatPropertyInfo where
    type AttrAllowedOps ZlibCompressorFormatPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ZlibCompressorFormatPropertyInfo = IsZlibCompressor
    type AttrSetTypeConstraint ZlibCompressorFormatPropertyInfo = (~) Gio.Enums.ZlibCompressorFormat
    type AttrTransferTypeConstraint ZlibCompressorFormatPropertyInfo = (~) Gio.Enums.ZlibCompressorFormat
    type AttrTransferType ZlibCompressorFormatPropertyInfo = Gio.Enums.ZlibCompressorFormat
    type AttrGetType ZlibCompressorFormatPropertyInfo = Gio.Enums.ZlibCompressorFormat
    type AttrLabel ZlibCompressorFormatPropertyInfo = "format"
    type AttrOrigin ZlibCompressorFormatPropertyInfo = ZlibCompressor
    attrGet :: forall o.
AttrBaseTypeConstraint ZlibCompressorFormatPropertyInfo o =>
o -> IO (AttrGetType ZlibCompressorFormatPropertyInfo)
attrGet = o -> IO (AttrGetType ZlibCompressorFormatPropertyInfo)
o -> IO ZlibCompressorFormat
forall (m :: * -> *) o.
(MonadIO m, IsZlibCompressor o) =>
o -> m ZlibCompressorFormat
getZlibCompressorFormat
    attrSet :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorFormatPropertyInfo o,
 AttrSetTypeConstraint ZlibCompressorFormatPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
    attrTransfer :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorFormatPropertyInfo o,
 AttrTransferTypeConstraint ZlibCompressorFormatPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType ZlibCompressorFormatPropertyInfo)
attrTransfer Proxy o
_ b
v = do
        b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
    attrConstruct :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorFormatPropertyInfo o,
 AttrSetTypeConstraint ZlibCompressorFormatPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
ZlibCompressorFormat -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsZlibCompressor o, MonadIO m) =>
ZlibCompressorFormat -> m (GValueConstruct o)
constructZlibCompressorFormat
    attrClear :: forall o.
AttrBaseTypeConstraint ZlibCompressorFormatPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
    dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ZlibCompressor.format"
        , resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ZlibCompressor.html#g:attr:format"
        })
#endif

-- VVV Prop "level"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a t'GValueConstruct' with valid value for the “@level@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructZlibCompressorLevel :: (IsZlibCompressor o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructZlibCompressorLevel :: forall o (m :: * -> *).
(IsZlibCompressor o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructZlibCompressorLevel Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"level" Int32
val

#if defined(ENABLE_OVERLOADING)
data ZlibCompressorLevelPropertyInfo
instance AttrInfo ZlibCompressorLevelPropertyInfo where
    type AttrAllowedOps ZlibCompressorLevelPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ZlibCompressorLevelPropertyInfo = IsZlibCompressor
    type AttrSetTypeConstraint ZlibCompressorLevelPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ZlibCompressorLevelPropertyInfo = (~) Int32
    type AttrTransferType ZlibCompressorLevelPropertyInfo = Int32
    type AttrGetType ZlibCompressorLevelPropertyInfo = Int32
    type AttrLabel ZlibCompressorLevelPropertyInfo = "level"
    type AttrOrigin ZlibCompressorLevelPropertyInfo = ZlibCompressor
    attrGet :: forall o.
AttrBaseTypeConstraint ZlibCompressorLevelPropertyInfo o =>
o -> IO (AttrGetType ZlibCompressorLevelPropertyInfo)
attrGet = o -> IO Int32
o -> IO (AttrGetType ZlibCompressorLevelPropertyInfo)
forall (m :: * -> *) o.
(MonadIO m, IsZlibCompressor o) =>
o -> m Int32
getZlibCompressorLevel
    attrSet :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorLevelPropertyInfo o,
 AttrSetTypeConstraint ZlibCompressorLevelPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
    attrTransfer :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorLevelPropertyInfo o,
 AttrTransferTypeConstraint ZlibCompressorLevelPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType ZlibCompressorLevelPropertyInfo)
attrTransfer Proxy o
_ b
v = do
        b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
    attrConstruct :: forall o b.
(AttrBaseTypeConstraint ZlibCompressorLevelPropertyInfo o,
 AttrSetTypeConstraint ZlibCompressorLevelPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
Int32 -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsZlibCompressor o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructZlibCompressorLevel
    attrClear :: forall o.
AttrBaseTypeConstraint ZlibCompressorLevelPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
    dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ZlibCompressor.level"
        , resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ZlibCompressor.html#g:attr:level"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ZlibCompressor
type instance O.AttributeList ZlibCompressor = ZlibCompressorAttributeList
type ZlibCompressorAttributeList = ('[ '("fileInfo", ZlibCompressorFileInfoPropertyInfo), '("format", ZlibCompressorFormatPropertyInfo), '("level", ZlibCompressorLevelPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
zlibCompressorFileInfo :: AttrLabelProxy "fileInfo"
zlibCompressorFileInfo :: AttrLabelProxy "fileInfo"
zlibCompressorFileInfo = AttrLabelProxy "fileInfo"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy

zlibCompressorFormat :: AttrLabelProxy "format"
zlibCompressorFormat :: AttrLabelProxy "format"
zlibCompressorFormat = AttrLabelProxy "format"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy

zlibCompressorLevel :: AttrLabelProxy "level"
zlibCompressorLevel :: AttrLabelProxy "level"
zlibCompressorLevel = AttrLabelProxy "level"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ZlibCompressor = ZlibCompressorSignalList
type ZlibCompressorSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method ZlibCompressor::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "ZlibCompressorFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The format to use for the compressed data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "level"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "compression level (0-9), -1 for default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "ZlibCompressor" })
-- throws : False
-- Skip return : False

foreign import ccall "g_zlib_compressor_new" g_zlib_compressor_new :: 
    CUInt ->                                -- format : TInterface (Name {namespace = "Gio", name = "ZlibCompressorFormat"})
    Int32 ->                                -- level : TBasicType TInt
    IO (Ptr ZlibCompressor)

-- | Creates a new t'GI.Gio.Objects.ZlibCompressor.ZlibCompressor'.
-- 
-- /Since: 2.24/
zlibCompressorNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gio.Enums.ZlibCompressorFormat
    -- ^ /@format@/: The format to use for the compressed data
    -> Int32
    -- ^ /@level@/: compression level (0-9), -1 for default
    -> m ZlibCompressor
    -- ^ __Returns:__ a new t'GI.Gio.Objects.ZlibCompressor.ZlibCompressor'
zlibCompressorNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ZlibCompressorFormat -> Int32 -> m ZlibCompressor
zlibCompressorNew ZlibCompressorFormat
format Int32
level = IO ZlibCompressor -> m ZlibCompressor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ZlibCompressor -> m ZlibCompressor)
-> IO ZlibCompressor -> m ZlibCompressor
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (ZlibCompressorFormat -> Int) -> ZlibCompressorFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZlibCompressorFormat -> Int
forall a. Enum a => a -> Int
fromEnum) ZlibCompressorFormat
format
    result <- CUInt -> Int32 -> IO (Ptr ZlibCompressor)
g_zlib_compressor_new CUInt
format' Int32
level
    checkUnexpectedReturnNULL "zlibCompressorNew" result
    result' <- (wrapObject ZlibCompressor) result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "g_zlib_compressor_get_file_info" g_zlib_compressor_get_file_info :: 
    Ptr ZlibCompressor ->                   -- compressor : TInterface (Name {namespace = "Gio", name = "ZlibCompressor"})
    IO (Ptr Gio.FileInfo.FileInfo)

-- | Returns the [ZlibCompressor:fileInfo]("GI.Gio.Objects.ZlibCompressor#g:attr:fileInfo") property.
-- 
-- /Since: 2.26/
zlibCompressorGetFileInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsZlibCompressor a) =>
    a
    -- ^ /@compressor@/: a t'GI.Gio.Objects.ZlibCompressor.ZlibCompressor'
    -> m (Maybe Gio.FileInfo.FileInfo)
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileInfo.FileInfo', or 'P.Nothing'
zlibCompressorGetFileInfo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsZlibCompressor a) =>
a -> m (Maybe FileInfo)
zlibCompressorGetFileInfo a
compressor = IO (Maybe FileInfo) -> m (Maybe FileInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FileInfo) -> m (Maybe FileInfo))
-> IO (Maybe FileInfo) -> m (Maybe FileInfo)
forall a b. (a -> b) -> a -> b
$ do
    compressor' <- a -> IO (Ptr ZlibCompressor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
compressor
    result <- g_zlib_compressor_get_file_info compressor'
    maybeResult <- convertIfNonNull result $ \Ptr FileInfo
result' -> do
        result'' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
result'
        return result''
    touchManagedPtr compressor
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data ZlibCompressorGetFileInfoMethodInfo
instance (signature ~ (m (Maybe Gio.FileInfo.FileInfo)), MonadIO m, IsZlibCompressor a) => O.OverloadedMethod ZlibCompressorGetFileInfoMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Maybe FileInfo)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsZlibCompressor a) =>
a -> m (Maybe FileInfo)
zlibCompressorGetFileInfo

instance O.OverloadedMethodInfo ZlibCompressorGetFileInfoMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ZlibCompressor.zlibCompressorGetFileInfo",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ZlibCompressor.html#v:zlibCompressorGetFileInfo"
        })


#endif

-- method ZlibCompressor::set_file_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "compressor"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ZlibCompressor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GZlibCompressor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file_info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInfo" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileInfo" , 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_zlib_compressor_set_file_info" g_zlib_compressor_set_file_info :: 
    Ptr ZlibCompressor ->                   -- compressor : TInterface (Name {namespace = "Gio", name = "ZlibCompressor"})
    Ptr Gio.FileInfo.FileInfo ->            -- file_info : TInterface (Name {namespace = "Gio", name = "FileInfo"})
    IO ()

-- | Sets /@fileInfo@/ in /@compressor@/. If non-'P.Nothing', and /@compressor@/\'s
-- [ZlibCompressor:format]("GI.Gio.Objects.ZlibCompressor#g:attr:format") property is 'GI.Gio.Enums.ZlibCompressorFormatGzip',
-- it will be used to set the file name and modification time in
-- the GZIP header of the compressed data.
-- 
-- Note: it is an error to call this function while a compression is in
-- progress; it may only be called immediately after creation of /@compressor@/,
-- or after resetting it with 'GI.Gio.Interfaces.Converter.converterReset'.
-- 
-- /Since: 2.26/
zlibCompressorSetFileInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsZlibCompressor a, Gio.FileInfo.IsFileInfo b) =>
    a
    -- ^ /@compressor@/: a t'GI.Gio.Objects.ZlibCompressor.ZlibCompressor'
    -> Maybe (b)
    -- ^ /@fileInfo@/: a t'GI.Gio.Objects.FileInfo.FileInfo'
    -> m ()
zlibCompressorSetFileInfo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsZlibCompressor a, IsFileInfo b) =>
a -> Maybe b -> m ()
zlibCompressorSetFileInfo a
compressor Maybe b
fileInfo = 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
    compressor' <- a -> IO (Ptr ZlibCompressor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
compressor
    maybeFileInfo <- case fileInfo of
        Maybe b
Nothing -> Ptr FileInfo -> IO (Ptr FileInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FileInfo
forall a. Ptr a
FP.nullPtr
        Just b
jFileInfo -> do
            jFileInfo' <- b -> IO (Ptr FileInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFileInfo
            return jFileInfo'
    g_zlib_compressor_set_file_info compressor' maybeFileInfo
    touchManagedPtr compressor
    whenJust fileInfo touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data ZlibCompressorSetFileInfoMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsZlibCompressor a, Gio.FileInfo.IsFileInfo b) => O.OverloadedMethod ZlibCompressorSetFileInfoMethodInfo a signature where
    overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsZlibCompressor a, IsFileInfo b) =>
a -> Maybe b -> m ()
zlibCompressorSetFileInfo

instance O.OverloadedMethodInfo ZlibCompressorSetFileInfoMethodInfo a where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ZlibCompressor.zlibCompressorSetFileInfo",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ZlibCompressor.html#v:zlibCompressorSetFileInfo"
        })


#endif