{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.GtkSource.Objects.FileSaver
    ( 

-- * Exported types
    FileSaver(..)                           ,
    IsFileSaver                             ,
    toFileSaver                             ,


 -- * 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"), [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"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [saveAsync]("GI.GtkSource.Objects.FileSaver#g:method:saveAsync"), [saveFinish]("GI.GtkSource.Objects.FileSaver#g:method:saveFinish"), [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
-- [getBuffer]("GI.GtkSource.Objects.FileSaver#g:method:getBuffer"), [getCompressionType]("GI.GtkSource.Objects.FileSaver#g:method:getCompressionType"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEncoding]("GI.GtkSource.Objects.FileSaver#g:method:getEncoding"), [getFile]("GI.GtkSource.Objects.FileSaver#g:method:getFile"), [getFlags]("GI.GtkSource.Objects.FileSaver#g:method:getFlags"), [getLocation]("GI.GtkSource.Objects.FileSaver#g:method:getLocation"), [getNewlineType]("GI.GtkSource.Objects.FileSaver#g:method:getNewlineType"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setCompressionType]("GI.GtkSource.Objects.FileSaver#g:method:setCompressionType"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEncoding]("GI.GtkSource.Objects.FileSaver#g:method:setEncoding"), [setFlags]("GI.GtkSource.Objects.FileSaver#g:method:setFlags"), [setNewlineType]("GI.GtkSource.Objects.FileSaver#g:method:setNewlineType"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFileSaverMethod                  ,
#endif

-- ** getBuffer #method:getBuffer#

#if defined(ENABLE_OVERLOADING)
    FileSaverGetBufferMethodInfo            ,
#endif
    fileSaverGetBuffer                      ,


-- ** getCompressionType #method:getCompressionType#

#if defined(ENABLE_OVERLOADING)
    FileSaverGetCompressionTypeMethodInfo   ,
#endif
    fileSaverGetCompressionType             ,


-- ** getEncoding #method:getEncoding#

#if defined(ENABLE_OVERLOADING)
    FileSaverGetEncodingMethodInfo          ,
#endif
    fileSaverGetEncoding                    ,


-- ** getFile #method:getFile#

#if defined(ENABLE_OVERLOADING)
    FileSaverGetFileMethodInfo              ,
#endif
    fileSaverGetFile                        ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    FileSaverGetFlagsMethodInfo             ,
#endif
    fileSaverGetFlags                       ,


-- ** getLocation #method:getLocation#

#if defined(ENABLE_OVERLOADING)
    FileSaverGetLocationMethodInfo          ,
#endif
    fileSaverGetLocation                    ,


-- ** getNewlineType #method:getNewlineType#

#if defined(ENABLE_OVERLOADING)
    FileSaverGetNewlineTypeMethodInfo       ,
#endif
    fileSaverGetNewlineType                 ,


-- ** new #method:new#

    fileSaverNew                            ,


-- ** newWithTarget #method:newWithTarget#

    fileSaverNewWithTarget                  ,


-- ** saveAsync #method:saveAsync#

#if defined(ENABLE_OVERLOADING)
    FileSaverSaveAsyncMethodInfo            ,
#endif
    fileSaverSaveAsync                      ,


-- ** saveFinish #method:saveFinish#

#if defined(ENABLE_OVERLOADING)
    FileSaverSaveFinishMethodInfo           ,
#endif
    fileSaverSaveFinish                     ,


-- ** setCompressionType #method:setCompressionType#

#if defined(ENABLE_OVERLOADING)
    FileSaverSetCompressionTypeMethodInfo   ,
#endif
    fileSaverSetCompressionType             ,


-- ** setEncoding #method:setEncoding#

#if defined(ENABLE_OVERLOADING)
    FileSaverSetEncodingMethodInfo          ,
#endif
    fileSaverSetEncoding                    ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    FileSaverSetFlagsMethodInfo             ,
#endif
    fileSaverSetFlags                       ,


-- ** setNewlineType #method:setNewlineType#

#if defined(ENABLE_OVERLOADING)
    FileSaverSetNewlineTypeMethodInfo       ,
#endif
    fileSaverSetNewlineType                 ,




 -- * Properties


-- ** buffer #attr:buffer#
-- | The t'GI.GtkSource.Objects.Buffer.Buffer' to save. The t'GI.GtkSource.Objects.FileSaver.FileSaver' object has a
-- weak reference to the buffer.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileSaverBufferPropertyInfo             ,
#endif
    constructFileSaverBuffer                ,
#if defined(ENABLE_OVERLOADING)
    fileSaverBuffer                         ,
#endif
    getFileSaverBuffer                      ,


-- ** compressionType #attr:compressionType#
-- | The compression type.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileSaverCompressionTypePropertyInfo    ,
#endif
    constructFileSaverCompressionType       ,
#if defined(ENABLE_OVERLOADING)
    fileSaverCompressionType                ,
#endif
    getFileSaverCompressionType             ,
    setFileSaverCompressionType             ,


-- ** encoding #attr:encoding#
-- | The file\'s encoding.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileSaverEncodingPropertyInfo           ,
#endif
    clearFileSaverEncoding                  ,
    constructFileSaverEncoding              ,
#if defined(ENABLE_OVERLOADING)
    fileSaverEncoding                       ,
#endif
    getFileSaverEncoding                    ,
    setFileSaverEncoding                    ,


-- ** file #attr:file#
-- | The t'GI.GtkSource.Objects.File.File'. The t'GI.GtkSource.Objects.FileSaver.FileSaver' object has a weak
-- reference to the file.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileSaverFilePropertyInfo               ,
#endif
    constructFileSaverFile                  ,
#if defined(ENABLE_OVERLOADING)
    fileSaverFile                           ,
#endif
    getFileSaverFile                        ,


-- ** flags #attr:flags#
-- | File saving flags.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileSaverFlagsPropertyInfo              ,
#endif
    constructFileSaverFlags                 ,
#if defined(ENABLE_OVERLOADING)
    fileSaverFlags                          ,
#endif
    getFileSaverFlags                       ,
    setFileSaverFlags                       ,


-- ** location #attr:location#
-- | The t'GI.Gio.Interfaces.File.File' where to save the buffer. By default the location is taken
-- from the t'GI.GtkSource.Objects.File.File' at construction time.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileSaverLocationPropertyInfo           ,
#endif
    constructFileSaverLocation              ,
#if defined(ENABLE_OVERLOADING)
    fileSaverLocation                       ,
#endif
    getFileSaverLocation                    ,


-- ** newlineType #attr:newlineType#
-- | The newline type.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileSaverNewlineTypePropertyInfo        ,
#endif
    constructFileSaverNewlineType           ,
#if defined(ENABLE_OVERLOADING)
    fileSaverNewlineType                    ,
#endif
    getFileSaverNewlineType                 ,
    setFileSaverNewlineType                 ,




    ) 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 GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.GtkSource.Enums as GtkSource.Enums
import {-# SOURCE #-} qualified GI.GtkSource.Flags as GtkSource.Flags
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Buffer as GtkSource.Buffer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.File as GtkSource.File
import {-# SOURCE #-} qualified GI.GtkSource.Structs.Encoding as GtkSource.Encoding

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

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

foreign import ccall "gtk_source_file_saver_get_type"
    c_gtk_source_file_saver_get_type :: IO B.Types.GType

instance B.Types.TypedObject FileSaver where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_file_saver_get_type

instance B.Types.GObject FileSaver

-- | Type class for types which can be safely cast to `FileSaver`, for instance with `toFileSaver`.
class (SP.GObject o, O.IsDescendantOf FileSaver o) => IsFileSaver o
instance (SP.GObject o, O.IsDescendantOf FileSaver o) => IsFileSaver o

instance O.HasParentTypes FileSaver
type instance O.ParentTypes FileSaver = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFileSaverMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFileSaverMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFileSaverMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFileSaverMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFileSaverMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFileSaverMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFileSaverMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFileSaverMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFileSaverMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFileSaverMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFileSaverMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFileSaverMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFileSaverMethod "saveAsync" o = FileSaverSaveAsyncMethodInfo
    ResolveFileSaverMethod "saveFinish" o = FileSaverSaveFinishMethodInfo
    ResolveFileSaverMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFileSaverMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFileSaverMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFileSaverMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFileSaverMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFileSaverMethod "getBuffer" o = FileSaverGetBufferMethodInfo
    ResolveFileSaverMethod "getCompressionType" o = FileSaverGetCompressionTypeMethodInfo
    ResolveFileSaverMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFileSaverMethod "getEncoding" o = FileSaverGetEncodingMethodInfo
    ResolveFileSaverMethod "getFile" o = FileSaverGetFileMethodInfo
    ResolveFileSaverMethod "getFlags" o = FileSaverGetFlagsMethodInfo
    ResolveFileSaverMethod "getLocation" o = FileSaverGetLocationMethodInfo
    ResolveFileSaverMethod "getNewlineType" o = FileSaverGetNewlineTypeMethodInfo
    ResolveFileSaverMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFileSaverMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFileSaverMethod "setCompressionType" o = FileSaverSetCompressionTypeMethodInfo
    ResolveFileSaverMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFileSaverMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFileSaverMethod "setEncoding" o = FileSaverSetEncodingMethodInfo
    ResolveFileSaverMethod "setFlags" o = FileSaverSetFlagsMethodInfo
    ResolveFileSaverMethod "setNewlineType" o = FileSaverSetNewlineTypeMethodInfo
    ResolveFileSaverMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFileSaverMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "buffer"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "Buffer"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@buffer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' fileSaver #buffer
-- @
getFileSaverBuffer :: (MonadIO m, IsFileSaver o) => o -> m GtkSource.Buffer.Buffer
getFileSaverBuffer :: forall (m :: * -> *) o. (MonadIO m, IsFileSaver o) => o -> m Buffer
getFileSaverBuffer o
obj = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Buffer) -> IO Buffer
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getFileSaverBuffer" (IO (Maybe Buffer) -> IO Buffer) -> IO (Maybe Buffer) -> IO Buffer
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Buffer -> Buffer) -> IO (Maybe Buffer)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"buffer" ManagedPtr Buffer -> Buffer
GtkSource.Buffer.Buffer

-- | Construct a `GValueConstruct` with valid value for the “@buffer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileSaverBuffer :: (IsFileSaver o, MIO.MonadIO m, GtkSource.Buffer.IsBuffer a) => a -> m (GValueConstruct o)
constructFileSaverBuffer :: forall o (m :: * -> *) a.
(IsFileSaver o, MonadIO m, IsBuffer a) =>
a -> m (GValueConstruct o)
constructFileSaverBuffer 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
"buffer" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data FileSaverBufferPropertyInfo
instance AttrInfo FileSaverBufferPropertyInfo where
    type AttrAllowedOps FileSaverBufferPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileSaverBufferPropertyInfo = IsFileSaver
    type AttrSetTypeConstraint FileSaverBufferPropertyInfo = GtkSource.Buffer.IsBuffer
    type AttrTransferTypeConstraint FileSaverBufferPropertyInfo = GtkSource.Buffer.IsBuffer
    type AttrTransferType FileSaverBufferPropertyInfo = GtkSource.Buffer.Buffer
    type AttrGetType FileSaverBufferPropertyInfo = GtkSource.Buffer.Buffer
    type AttrLabel FileSaverBufferPropertyInfo = "buffer"
    type AttrOrigin FileSaverBufferPropertyInfo = FileSaver
    attrGet = getFileSaverBuffer
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo GtkSource.Buffer.Buffer v
    attrConstruct = constructFileSaverBuffer
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.buffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#g:attr:buffer"
        })
#endif

-- VVV Prop "compression-type"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "CompressionType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@compression-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileSaver [ #compressionType 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileSaverCompressionType :: (MonadIO m, IsFileSaver o) => o -> GtkSource.Enums.CompressionType -> m ()
setFileSaverCompressionType :: forall (m :: * -> *) o.
(MonadIO m, IsFileSaver o) =>
o -> CompressionType -> m ()
setFileSaverCompressionType o
obj CompressionType
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 -> CompressionType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"compression-type" CompressionType
val

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

#if defined(ENABLE_OVERLOADING)
data FileSaverCompressionTypePropertyInfo
instance AttrInfo FileSaverCompressionTypePropertyInfo where
    type AttrAllowedOps FileSaverCompressionTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FileSaverCompressionTypePropertyInfo = IsFileSaver
    type AttrSetTypeConstraint FileSaverCompressionTypePropertyInfo = (~) GtkSource.Enums.CompressionType
    type AttrTransferTypeConstraint FileSaverCompressionTypePropertyInfo = (~) GtkSource.Enums.CompressionType
    type AttrTransferType FileSaverCompressionTypePropertyInfo = GtkSource.Enums.CompressionType
    type AttrGetType FileSaverCompressionTypePropertyInfo = GtkSource.Enums.CompressionType
    type AttrLabel FileSaverCompressionTypePropertyInfo = "compression-type"
    type AttrOrigin FileSaverCompressionTypePropertyInfo = FileSaver
    attrGet = getFileSaverCompressionType
    attrSet = setFileSaverCompressionType
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileSaverCompressionType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.compressionType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#g:attr:compressionType"
        })
#endif

-- VVV Prop "encoding"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "Encoding"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just True)

-- | Get the value of the “@encoding@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' fileSaver #encoding
-- @
getFileSaverEncoding :: (MonadIO m, IsFileSaver o) => o -> m GtkSource.Encoding.Encoding
getFileSaverEncoding :: forall (m :: * -> *) o.
(MonadIO m, IsFileSaver o) =>
o -> m Encoding
getFileSaverEncoding o
obj = IO Encoding -> m Encoding
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Encoding -> m Encoding) -> IO Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Encoding) -> IO Encoding
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getFileSaverEncoding" (IO (Maybe Encoding) -> IO Encoding)
-> IO (Maybe Encoding) -> IO Encoding
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr Encoding -> Encoding)
-> IO (Maybe Encoding)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"encoding" ManagedPtr Encoding -> Encoding
GtkSource.Encoding.Encoding

-- | Set the value of the “@encoding@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileSaver [ #encoding 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileSaverEncoding :: (MonadIO m, IsFileSaver o) => o -> GtkSource.Encoding.Encoding -> m ()
setFileSaverEncoding :: forall (m :: * -> *) o.
(MonadIO m, IsFileSaver o) =>
o -> Encoding -> m ()
setFileSaverEncoding o
obj Encoding
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 Encoding -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"encoding" (Encoding -> Maybe Encoding
forall a. a -> Maybe a
Just Encoding
val)

-- | Construct a `GValueConstruct` with valid value for the “@encoding@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileSaverEncoding :: (IsFileSaver o, MIO.MonadIO m) => GtkSource.Encoding.Encoding -> m (GValueConstruct o)
constructFileSaverEncoding :: forall o (m :: * -> *).
(IsFileSaver o, MonadIO m) =>
Encoding -> m (GValueConstruct o)
constructFileSaverEncoding Encoding
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 Encoding -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"encoding" (Encoding -> Maybe Encoding
forall a. a -> Maybe a
P.Just Encoding
val)

-- | Set the value of the “@encoding@” 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' #encoding
-- @
clearFileSaverEncoding :: (MonadIO m, IsFileSaver o) => o -> m ()
clearFileSaverEncoding :: forall (m :: * -> *) o. (MonadIO m, IsFileSaver o) => o -> m ()
clearFileSaverEncoding 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 Encoding -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"encoding" (Maybe Encoding
forall a. Maybe a
Nothing :: Maybe GtkSource.Encoding.Encoding)

#if defined(ENABLE_OVERLOADING)
data FileSaverEncodingPropertyInfo
instance AttrInfo FileSaverEncodingPropertyInfo where
    type AttrAllowedOps FileSaverEncodingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileSaverEncodingPropertyInfo = IsFileSaver
    type AttrSetTypeConstraint FileSaverEncodingPropertyInfo = (~) GtkSource.Encoding.Encoding
    type AttrTransferTypeConstraint FileSaverEncodingPropertyInfo = (~) GtkSource.Encoding.Encoding
    type AttrTransferType FileSaverEncodingPropertyInfo = GtkSource.Encoding.Encoding
    type AttrGetType FileSaverEncodingPropertyInfo = GtkSource.Encoding.Encoding
    type AttrLabel FileSaverEncodingPropertyInfo = "encoding"
    type AttrOrigin FileSaverEncodingPropertyInfo = FileSaver
    attrGet = getFileSaverEncoding
    attrSet = setFileSaverEncoding
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileSaverEncoding
    attrClear = clearFileSaverEncoding
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.encoding"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#g:attr:encoding"
        })
#endif

-- VVV Prop "file"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "File"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@file@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileSaverFile :: (IsFileSaver o, MIO.MonadIO m, GtkSource.File.IsFile a) => a -> m (GValueConstruct o)
constructFileSaverFile :: forall o (m :: * -> *) a.
(IsFileSaver o, MonadIO m, IsFile a) =>
a -> m (GValueConstruct o)
constructFileSaverFile 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" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data FileSaverFilePropertyInfo
instance AttrInfo FileSaverFilePropertyInfo where
    type AttrAllowedOps FileSaverFilePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileSaverFilePropertyInfo = IsFileSaver
    type AttrSetTypeConstraint FileSaverFilePropertyInfo = GtkSource.File.IsFile
    type AttrTransferTypeConstraint FileSaverFilePropertyInfo = GtkSource.File.IsFile
    type AttrTransferType FileSaverFilePropertyInfo = GtkSource.File.File
    type AttrGetType FileSaverFilePropertyInfo = GtkSource.File.File
    type AttrLabel FileSaverFilePropertyInfo = "file"
    type AttrOrigin FileSaverFilePropertyInfo = FileSaver
    attrGet = getFileSaverFile
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo GtkSource.File.File v
    attrConstruct = constructFileSaverFile
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.file"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#g:attr:file"
        })
#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "FileSaverFlags"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' fileSaver #flags
-- @
getFileSaverFlags :: (MonadIO m, IsFileSaver o) => o -> m [GtkSource.Flags.FileSaverFlags]
getFileSaverFlags :: forall (m :: * -> *) o.
(MonadIO m, IsFileSaver o) =>
o -> m [FileSaverFlags]
getFileSaverFlags o
obj = IO [FileSaverFlags] -> m [FileSaverFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [FileSaverFlags] -> m [FileSaverFlags])
-> IO [FileSaverFlags] -> m [FileSaverFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [FileSaverFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Set the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileSaver [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileSaverFlags :: (MonadIO m, IsFileSaver o) => o -> [GtkSource.Flags.FileSaverFlags] -> m ()
setFileSaverFlags :: forall (m :: * -> *) o.
(MonadIO m, IsFileSaver o) =>
o -> [FileSaverFlags] -> m ()
setFileSaverFlags o
obj [FileSaverFlags]
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 -> [FileSaverFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"flags" [FileSaverFlags]
val

-- | Construct a `GValueConstruct` with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileSaverFlags :: (IsFileSaver o, MIO.MonadIO m) => [GtkSource.Flags.FileSaverFlags] -> m (GValueConstruct o)
constructFileSaverFlags :: forall o (m :: * -> *).
(IsFileSaver o, MonadIO m) =>
[FileSaverFlags] -> m (GValueConstruct o)
constructFileSaverFlags [FileSaverFlags]
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 -> [FileSaverFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [FileSaverFlags]
val

#if defined(ENABLE_OVERLOADING)
data FileSaverFlagsPropertyInfo
instance AttrInfo FileSaverFlagsPropertyInfo where
    type AttrAllowedOps FileSaverFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FileSaverFlagsPropertyInfo = IsFileSaver
    type AttrSetTypeConstraint FileSaverFlagsPropertyInfo = (~) [GtkSource.Flags.FileSaverFlags]
    type AttrTransferTypeConstraint FileSaverFlagsPropertyInfo = (~) [GtkSource.Flags.FileSaverFlags]
    type AttrTransferType FileSaverFlagsPropertyInfo = [GtkSource.Flags.FileSaverFlags]
    type AttrGetType FileSaverFlagsPropertyInfo = [GtkSource.Flags.FileSaverFlags]
    type AttrLabel FileSaverFlagsPropertyInfo = "flags"
    type AttrOrigin FileSaverFlagsPropertyInfo = FileSaver
    attrGet = getFileSaverFlags
    attrSet = setFileSaverFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileSaverFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#g:attr:flags"
        })
#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@location@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileSaverLocation :: (IsFileSaver o, MIO.MonadIO m, Gio.File.IsFile a) => a -> m (GValueConstruct o)
constructFileSaverLocation :: forall o (m :: * -> *) a.
(IsFileSaver o, MonadIO m, IsFile a) =>
a -> m (GValueConstruct o)
constructFileSaverLocation 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
"location" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data FileSaverLocationPropertyInfo
instance AttrInfo FileSaverLocationPropertyInfo where
    type AttrAllowedOps FileSaverLocationPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileSaverLocationPropertyInfo = IsFileSaver
    type AttrSetTypeConstraint FileSaverLocationPropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint FileSaverLocationPropertyInfo = Gio.File.IsFile
    type AttrTransferType FileSaverLocationPropertyInfo = Gio.File.File
    type AttrGetType FileSaverLocationPropertyInfo = Gio.File.File
    type AttrLabel FileSaverLocationPropertyInfo = "location"
    type AttrOrigin FileSaverLocationPropertyInfo = FileSaver
    attrGet = getFileSaverLocation
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructFileSaverLocation
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.location"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#g:attr:location"
        })
#endif

-- VVV Prop "newline-type"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "NewlineType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@newline-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileSaver [ #newlineType 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileSaverNewlineType :: (MonadIO m, IsFileSaver o) => o -> GtkSource.Enums.NewlineType -> m ()
setFileSaverNewlineType :: forall (m :: * -> *) o.
(MonadIO m, IsFileSaver o) =>
o -> NewlineType -> m ()
setFileSaverNewlineType o
obj NewlineType
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 -> NewlineType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"newline-type" NewlineType
val

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

#if defined(ENABLE_OVERLOADING)
data FileSaverNewlineTypePropertyInfo
instance AttrInfo FileSaverNewlineTypePropertyInfo where
    type AttrAllowedOps FileSaverNewlineTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FileSaverNewlineTypePropertyInfo = IsFileSaver
    type AttrSetTypeConstraint FileSaverNewlineTypePropertyInfo = (~) GtkSource.Enums.NewlineType
    type AttrTransferTypeConstraint FileSaverNewlineTypePropertyInfo = (~) GtkSource.Enums.NewlineType
    type AttrTransferType FileSaverNewlineTypePropertyInfo = GtkSource.Enums.NewlineType
    type AttrGetType FileSaverNewlineTypePropertyInfo = GtkSource.Enums.NewlineType
    type AttrLabel FileSaverNewlineTypePropertyInfo = "newline-type"
    type AttrOrigin FileSaverNewlineTypePropertyInfo = FileSaver
    attrGet = getFileSaverNewlineType
    attrSet = setFileSaverNewlineType
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileSaverNewlineType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.newlineType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#g:attr:newlineType"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FileSaver
type instance O.AttributeList FileSaver = FileSaverAttributeList
type FileSaverAttributeList = ('[ '("buffer", FileSaverBufferPropertyInfo), '("compressionType", FileSaverCompressionTypePropertyInfo), '("encoding", FileSaverEncodingPropertyInfo), '("file", FileSaverFilePropertyInfo), '("flags", FileSaverFlagsPropertyInfo), '("location", FileSaverLocationPropertyInfo), '("newlineType", FileSaverNewlineTypePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
fileSaverBuffer :: AttrLabelProxy "buffer"
fileSaverBuffer = AttrLabelProxy

fileSaverCompressionType :: AttrLabelProxy "compressionType"
fileSaverCompressionType = AttrLabelProxy

fileSaverEncoding :: AttrLabelProxy "encoding"
fileSaverEncoding = AttrLabelProxy

fileSaverFile :: AttrLabelProxy "file"
fileSaverFile = AttrLabelProxy

fileSaverFlags :: AttrLabelProxy "flags"
fileSaverFlags = AttrLabelProxy

fileSaverLocation :: AttrLabelProxy "location"
fileSaverLocation = AttrLabelProxy

fileSaverNewlineType :: AttrLabelProxy "newlineType"
fileSaverNewlineType = AttrLabelProxy

#endif

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

#endif

-- method FileSaver::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkSourceBuffer to save."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkSourceFile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "FileSaver" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_new" gtk_source_file_saver_new :: 
    Ptr GtkSource.Buffer.Buffer ->          -- buffer : TInterface (Name {namespace = "GtkSource", name = "Buffer"})
    Ptr GtkSource.File.File ->              -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    IO (Ptr FileSaver)

-- | Creates a new t'GI.GtkSource.Objects.FileSaver.FileSaver' object. The /@buffer@/ will be saved to the
-- t'GI.GtkSource.Objects.File.File'\'s location.
-- 
-- This constructor is suitable for a simple \"save\" operation, when the /@file@/
-- already contains a non-'P.Nothing' [File:location]("GI.GtkSource.Objects.File#g:attr:location").
-- 
-- /Since: 3.14/
fileSaverNew ::
    (B.CallStack.HasCallStack, MonadIO m, GtkSource.Buffer.IsBuffer a, GtkSource.File.IsFile b) =>
    a
    -- ^ /@buffer@/: the t'GI.GtkSource.Objects.Buffer.Buffer' to save.
    -> b
    -- ^ /@file@/: the t'GI.GtkSource.Objects.File.File'.
    -> m FileSaver
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.FileSaver.FileSaver' object.
fileSaverNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBuffer a, IsFile b) =>
a -> b -> m FileSaver
fileSaverNew a
buffer b
file = IO FileSaver -> m FileSaver
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileSaver -> m FileSaver) -> IO FileSaver -> m FileSaver
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- a -> IO (Ptr Buffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    Ptr FileSaver
result <- Ptr Buffer -> Ptr File -> IO (Ptr FileSaver)
gtk_source_file_saver_new Ptr Buffer
buffer' Ptr File
file'
    Text -> Ptr FileSaver -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileSaverNew" Ptr FileSaver
result
    FileSaver
result' <- ((ManagedPtr FileSaver -> FileSaver)
-> Ptr FileSaver -> IO FileSaver
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileSaver -> FileSaver
FileSaver) Ptr FileSaver
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
    FileSaver -> IO FileSaver
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileSaver
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FileSaver::new_with_target
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkSourceBuffer to save."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GtkSourceFile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_location"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GFile where to save the buffer to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "FileSaver" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_new_with_target" gtk_source_file_saver_new_with_target :: 
    Ptr GtkSource.Buffer.Buffer ->          -- buffer : TInterface (Name {namespace = "GtkSource", name = "Buffer"})
    Ptr GtkSource.File.File ->              -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    Ptr Gio.File.File ->                    -- target_location : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr FileSaver)

-- | Creates a new t'GI.GtkSource.Objects.FileSaver.FileSaver' object with a target location. When the
-- file saving is finished successfully, /@targetLocation@/ is set to the /@file@/\'s
-- [File:location]("GI.GtkSource.Objects.File#g:attr:location") property. If an error occurs, the previous valid
-- location is still available in t'GI.GtkSource.Objects.File.File'.
-- 
-- This constructor is suitable for a \"save as\" operation, or for saving a new
-- buffer for the first time.
-- 
-- /Since: 3.14/
fileSaverNewWithTarget ::
    (B.CallStack.HasCallStack, MonadIO m, GtkSource.Buffer.IsBuffer a, GtkSource.File.IsFile b, Gio.File.IsFile c) =>
    a
    -- ^ /@buffer@/: the t'GI.GtkSource.Objects.Buffer.Buffer' to save.
    -> b
    -- ^ /@file@/: the t'GI.GtkSource.Objects.File.File'.
    -> c
    -- ^ /@targetLocation@/: the t'GI.Gio.Interfaces.File.File' where to save the buffer to.
    -> m FileSaver
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.FileSaver.FileSaver' object.
fileSaverNewWithTarget :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsBuffer a, IsFile b, IsFile c) =>
a -> b -> c -> m FileSaver
fileSaverNewWithTarget a
buffer b
file c
targetLocation = IO FileSaver -> m FileSaver
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileSaver -> m FileSaver) -> IO FileSaver -> m FileSaver
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- a -> IO (Ptr Buffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    Ptr File
targetLocation' <- c -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
targetLocation
    Ptr FileSaver
result <- Ptr Buffer -> Ptr File -> Ptr File -> IO (Ptr FileSaver)
gtk_source_file_saver_new_with_target Ptr Buffer
buffer' Ptr File
file' Ptr File
targetLocation'
    Text -> Ptr FileSaver -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileSaverNewWithTarget" Ptr FileSaver
result
    FileSaver
result' <- ((ManagedPtr FileSaver -> FileSaver)
-> Ptr FileSaver -> IO FileSaver
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileSaver -> FileSaver
FileSaver) Ptr FileSaver
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
targetLocation
    FileSaver -> IO FileSaver
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileSaver
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FileSaver::get_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_get_buffer" gtk_source_file_saver_get_buffer :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    IO (Ptr GtkSource.Buffer.Buffer)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileSaverGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> m GtkSource.Buffer.Buffer
    -- ^ __Returns:__ the t'GI.GtkSource.Objects.Buffer.Buffer' to save.
fileSaverGetBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> m Buffer
fileSaverGetBuffer a
saver = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    Ptr Buffer
result <- Ptr FileSaver -> IO (Ptr Buffer)
gtk_source_file_saver_get_buffer Ptr FileSaver
saver'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileSaverGetBuffer" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Buffer -> Buffer
GtkSource.Buffer.Buffer) Ptr Buffer
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data FileSaverGetBufferMethodInfo
instance (signature ~ (m GtkSource.Buffer.Buffer), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverGetBufferMethodInfo a signature where
    overloadedMethod = fileSaverGetBuffer

instance O.OverloadedMethodInfo FileSaverGetBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverGetBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverGetBuffer"
        })


#endif

-- method FileSaver::get_compression_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "CompressionType" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_get_compression_type" gtk_source_file_saver_get_compression_type :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileSaverGetCompressionType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> m GtkSource.Enums.CompressionType
    -- ^ __Returns:__ the compression type.
fileSaverGetCompressionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> m CompressionType
fileSaverGetCompressionType a
saver = IO CompressionType -> m CompressionType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompressionType -> m CompressionType)
-> IO CompressionType -> m CompressionType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    CUInt
result <- Ptr FileSaver -> IO CUInt
gtk_source_file_saver_get_compression_type Ptr FileSaver
saver'
    let result' :: CompressionType
result' = (Int -> CompressionType
forall a. Enum a => Int -> a
toEnum (Int -> CompressionType)
-> (CUInt -> Int) -> CUInt -> CompressionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    CompressionType -> IO CompressionType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionType
result'

#if defined(ENABLE_OVERLOADING)
data FileSaverGetCompressionTypeMethodInfo
instance (signature ~ (m GtkSource.Enums.CompressionType), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverGetCompressionTypeMethodInfo a signature where
    overloadedMethod = fileSaverGetCompressionType

instance O.OverloadedMethodInfo FileSaverGetCompressionTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverGetCompressionType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverGetCompressionType"
        })


#endif

-- method FileSaver::get_encoding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "Encoding" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_get_encoding" gtk_source_file_saver_get_encoding :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    IO (Ptr GtkSource.Encoding.Encoding)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileSaverGetEncoding ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> m GtkSource.Encoding.Encoding
    -- ^ __Returns:__ the encoding.
fileSaverGetEncoding :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> m Encoding
fileSaverGetEncoding a
saver = IO Encoding -> m Encoding
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Encoding -> m Encoding) -> IO Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    Ptr Encoding
result <- Ptr FileSaver -> IO (Ptr Encoding)
gtk_source_file_saver_get_encoding Ptr FileSaver
saver'
    Text -> Ptr Encoding -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileSaverGetEncoding" Ptr Encoding
result
    Encoding
result' <- ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Encoding -> Encoding
GtkSource.Encoding.Encoding) Ptr Encoding
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    Encoding -> IO Encoding
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
result'

#if defined(ENABLE_OVERLOADING)
data FileSaverGetEncodingMethodInfo
instance (signature ~ (m GtkSource.Encoding.Encoding), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverGetEncodingMethodInfo a signature where
    overloadedMethod = fileSaverGetEncoding

instance O.OverloadedMethodInfo FileSaverGetEncodingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverGetEncoding",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverGetEncoding"
        })


#endif

-- method FileSaver::get_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GtkSource" , name = "File" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_get_file" gtk_source_file_saver_get_file :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    IO (Ptr GtkSource.File.File)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileSaverGetFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> m GtkSource.File.File
    -- ^ __Returns:__ the t'GI.GtkSource.Objects.File.File'.
fileSaverGetFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> m File
fileSaverGetFile a
saver = IO File -> m File
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    Ptr File
result <- Ptr FileSaver -> IO (Ptr File)
gtk_source_file_saver_get_file Ptr FileSaver
saver'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileSaverGetFile" Ptr File
result
    File
result' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
GtkSource.File.File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data FileSaverGetFileMethodInfo
instance (signature ~ (m GtkSource.File.File), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverGetFileMethodInfo a signature where
    overloadedMethod = fileSaverGetFile

instance O.OverloadedMethodInfo FileSaverGetFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverGetFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverGetFile"
        })


#endif

-- method FileSaver::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "FileSaverFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_get_flags" gtk_source_file_saver_get_flags :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileSaverGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> m [GtkSource.Flags.FileSaverFlags]
    -- ^ __Returns:__ the flags.
fileSaverGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> m [FileSaverFlags]
fileSaverGetFlags a
saver = IO [FileSaverFlags] -> m [FileSaverFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FileSaverFlags] -> m [FileSaverFlags])
-> IO [FileSaverFlags] -> m [FileSaverFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    CUInt
result <- Ptr FileSaver -> IO CUInt
gtk_source_file_saver_get_flags Ptr FileSaver
saver'
    let result' :: [FileSaverFlags]
result' = CUInt -> [FileSaverFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    [FileSaverFlags] -> IO [FileSaverFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FileSaverFlags]
result'

#if defined(ENABLE_OVERLOADING)
data FileSaverGetFlagsMethodInfo
instance (signature ~ (m [GtkSource.Flags.FileSaverFlags]), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverGetFlagsMethodInfo a signature where
    overloadedMethod = fileSaverGetFlags

instance O.OverloadedMethodInfo FileSaverGetFlagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverGetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverGetFlags"
        })


#endif

-- method FileSaver::get_location
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_get_location" gtk_source_file_saver_get_location :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    IO (Ptr Gio.File.File)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileSaverGetLocation ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> m Gio.File.File
    -- ^ __Returns:__ the t'GI.Gio.Interfaces.File.File' where to save the buffer to.
fileSaverGetLocation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> m File
fileSaverGetLocation a
saver = IO File -> m File
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    Ptr File
result <- Ptr FileSaver -> IO (Ptr File)
gtk_source_file_saver_get_location Ptr FileSaver
saver'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileSaverGetLocation" Ptr File
result
    File
result' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data FileSaverGetLocationMethodInfo
instance (signature ~ (m Gio.File.File), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverGetLocationMethodInfo a signature where
    overloadedMethod = fileSaverGetLocation

instance O.OverloadedMethodInfo FileSaverGetLocationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverGetLocation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverGetLocation"
        })


#endif

-- method FileSaver::get_newline_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "NewlineType" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_get_newline_type" gtk_source_file_saver_get_newline_type :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileSaverGetNewlineType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> m GtkSource.Enums.NewlineType
    -- ^ __Returns:__ the newline type.
fileSaverGetNewlineType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> m NewlineType
fileSaverGetNewlineType a
saver = IO NewlineType -> m NewlineType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NewlineType -> m NewlineType)
-> IO NewlineType -> m NewlineType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    CUInt
result <- Ptr FileSaver -> IO CUInt
gtk_source_file_saver_get_newline_type Ptr FileSaver
saver'
    let result' :: NewlineType
result' = (Int -> NewlineType
forall a. Enum a => Int -> a
toEnum (Int -> NewlineType) -> (CUInt -> Int) -> CUInt -> NewlineType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    NewlineType -> IO NewlineType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NewlineType
result'

#if defined(ENABLE_OVERLOADING)
data FileSaverGetNewlineTypeMethodInfo
instance (signature ~ (m GtkSource.Enums.NewlineType), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverGetNewlineTypeMethodInfo a signature where
    overloadedMethod = fileSaverGetNewlineType

instance O.OverloadedMethodInfo FileSaverGetNewlineTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverGetNewlineType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverGetNewlineType"
        })


#endif

-- method FileSaver::save_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the I/O priority of the request. E.g. %G_PRIORITY_LOW,\n  %G_PRIORITY_DEFAULT or %G_PRIORITY_HIGH."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress_callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "FileProgressCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "function to call back with\n  progress information, or %NULL if progress information is not needed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 4
--           , argDestroy = 5
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress_callback_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @progress_callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress_callback_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "function to call on\n  @progress_callback_data when the @progress_callback is no longer needed, or\n  %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the request is\n  satisfied."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_save_async" gtk_source_file_saver_save_async :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    Int32 ->                                -- io_priority : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_FileProgressCallback -> -- progress_callback : TInterface (Name {namespace = "Gio", name = "FileProgressCallback"})
    Ptr () ->                               -- progress_callback_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- progress_callback_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Saves asynchronously the buffer into the file. See the t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
-- documentation to know how to use this function.
-- 
-- /Since: 3.14/
fileSaverSaveAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request. E.g. 'GI.GLib.Constants.PRIORITY_LOW',
    --   'GI.GLib.Constants.PRIORITY_DEFAULT' or 'GI.GLib.Constants.PRIORITY_HIGH'.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> Maybe (Gio.Callbacks.FileProgressCallback)
    -- ^ /@progressCallback@/: function to call back with
    --   progress information, or 'P.Nothing' if progress information is not needed.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is
    --   satisfied.
    -> m ()
fileSaverSaveAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileSaver a, IsCancellable b) =>
a
-> Int32
-> Maybe b
-> Maybe FileProgressCallback
-> Maybe AsyncReadyCallback
-> m ()
fileSaverSaveAsync a
saver Int32
ioPriority Maybe b
cancellable Maybe FileProgressCallback
progressCallback Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr FileProgressCallback
maybeProgressCallback <- case Maybe FileProgressCallback
progressCallback of
        Maybe FileProgressCallback
Nothing -> FunPtr FileProgressCallback -> IO (FunPtr FileProgressCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr FileProgressCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just FileProgressCallback
jProgressCallback -> do
            FunPtr FileProgressCallback
jProgressCallback' <- FileProgressCallback -> IO (FunPtr FileProgressCallback)
Gio.Callbacks.mk_FileProgressCallback (Maybe (Ptr (FunPtr FileProgressCallback))
-> FileProgressCallback -> FileProgressCallback
Gio.Callbacks.wrap_FileProgressCallback Maybe (Ptr (FunPtr FileProgressCallback))
forall a. Maybe a
Nothing FileProgressCallback
jProgressCallback)
            FunPtr FileProgressCallback -> IO (FunPtr FileProgressCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr FileProgressCallback
jProgressCallback'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let progressCallbackData :: Ptr ()
progressCallbackData = FunPtr FileProgressCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr FileProgressCallback
maybeProgressCallback
    let progressCallbackNotify :: FunPtr (Ptr a -> IO ())
progressCallbackNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileSaver
-> Int32
-> Ptr Cancellable
-> FunPtr FileProgressCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> FunPtr C_AsyncReadyCallback
-> C_DestroyNotify
gtk_source_file_saver_save_async Ptr FileSaver
saver' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr FileProgressCallback
maybeProgressCallback Ptr ()
progressCallbackData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
progressCallbackNotify FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileSaverSaveAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.FileProgressCallback) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileSaver a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSaverSaveAsyncMethodInfo a signature where
    overloadedMethod = fileSaverSaveAsync

instance O.OverloadedMethodInfo FileSaverSaveAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverSaveAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverSaveAsync"
        })


#endif

-- method FileSaver::save_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_file_saver_save_finish" gtk_source_file_saver_save_finish :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a file saving started with 'GI.GtkSource.Objects.FileSaver.fileSaverSaveAsync'.
-- 
-- If the file has been saved successfully, the following t'GI.GtkSource.Objects.File.File'
-- properties will be updated: the location, the encoding, the newline type and
-- the compression type.
-- 
-- Since the 3.20 version, 'GI.Gtk.Objects.TextBuffer.textBufferSetModified' is called with 'P.False'
-- if the file has been saved successfully.
-- 
-- /Since: 3.14/
fileSaverSaveFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSaverSaveFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileSaver a, IsAsyncResult b) =>
a -> b -> m ()
fileSaverSaveFinish a
saver b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr FileSaver -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
gtk_source_file_saver_save_finish Ptr FileSaver
saver' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileSaverSaveFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFileSaver a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileSaverSaveFinishMethodInfo a signature where
    overloadedMethod = fileSaverSaveFinish

instance O.OverloadedMethodInfo FileSaverSaveFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverSaveFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverSaveFinish"
        })


#endif

-- method FileSaver::set_compression_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compression_type"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompressionType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new compression type."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_set_compression_type" gtk_source_file_saver_set_compression_type :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    CUInt ->                                -- compression_type : TInterface (Name {namespace = "GtkSource", name = "CompressionType"})
    IO ()

-- | Sets the compression type. By default the compression type is taken from the
-- t'GI.GtkSource.Objects.File.File'.
-- 
-- /Since: 3.14/
fileSaverSetCompressionType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> GtkSource.Enums.CompressionType
    -- ^ /@compressionType@/: the new compression type.
    -> m ()
fileSaverSetCompressionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> CompressionType -> m ()
fileSaverSetCompressionType a
saver CompressionType
compressionType = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    let compressionType' :: CUInt
compressionType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (CompressionType -> Int) -> CompressionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressionType -> Int
forall a. Enum a => a -> Int
fromEnum) CompressionType
compressionType
    Ptr FileSaver -> CUInt -> IO ()
gtk_source_file_saver_set_compression_type Ptr FileSaver
saver' CUInt
compressionType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileSaverSetCompressionTypeMethodInfo
instance (signature ~ (GtkSource.Enums.CompressionType -> m ()), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverSetCompressionTypeMethodInfo a signature where
    overloadedMethod = fileSaverSetCompressionType

instance O.OverloadedMethodInfo FileSaverSetCompressionTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverSetCompressionType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverSetCompressionType"
        })


#endif

-- method FileSaver::set_encoding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "encoding"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Encoding" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new encoding, or %NULL for UTF-8."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_set_encoding" gtk_source_file_saver_set_encoding :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    Ptr GtkSource.Encoding.Encoding ->      -- encoding : TInterface (Name {namespace = "GtkSource", name = "Encoding"})
    IO ()

-- | Sets the encoding. If /@encoding@/ is 'P.Nothing', the UTF-8 encoding will be set.
-- By default the encoding is taken from the t'GI.GtkSource.Objects.File.File'.
-- 
-- /Since: 3.14/
fileSaverSetEncoding ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> Maybe (GtkSource.Encoding.Encoding)
    -- ^ /@encoding@/: the new encoding, or 'P.Nothing' for UTF-8.
    -> m ()
fileSaverSetEncoding :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> Maybe Encoding -> m ()
fileSaverSetEncoding a
saver Maybe Encoding
encoding = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    Ptr Encoding
maybeEncoding <- case Maybe Encoding
encoding of
        Maybe Encoding
Nothing -> Ptr Encoding -> IO (Ptr Encoding)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Encoding
forall a. Ptr a
nullPtr
        Just Encoding
jEncoding -> do
            Ptr Encoding
jEncoding' <- Encoding -> IO (Ptr Encoding)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Encoding
jEncoding
            Ptr Encoding -> IO (Ptr Encoding)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Encoding
jEncoding'
    Ptr FileSaver -> Ptr Encoding -> IO ()
gtk_source_file_saver_set_encoding Ptr FileSaver
saver' Ptr Encoding
maybeEncoding
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    Maybe Encoding -> (Encoding -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Encoding
encoding Encoding -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileSaverSetEncodingMethodInfo
instance (signature ~ (Maybe (GtkSource.Encoding.Encoding) -> m ()), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverSetEncodingMethodInfo a signature where
    overloadedMethod = fileSaverSetEncoding

instance O.OverloadedMethodInfo FileSaverSetEncodingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverSetEncoding",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverSetEncoding"
        })


#endif

-- method FileSaver::set_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "FileSaverFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new flags." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_set_flags" gtk_source_file_saver_set_flags :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GtkSource", name = "FileSaverFlags"})
    IO ()

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileSaverSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> [GtkSource.Flags.FileSaverFlags]
    -- ^ /@flags@/: the new flags.
    -> m ()
fileSaverSetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> [FileSaverFlags] -> m ()
fileSaverSetFlags a
saver [FileSaverFlags]
flags = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    let flags' :: CUInt
flags' = [FileSaverFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileSaverFlags]
flags
    Ptr FileSaver -> CUInt -> IO ()
gtk_source_file_saver_set_flags Ptr FileSaver
saver' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileSaverSetFlagsMethodInfo
instance (signature ~ ([GtkSource.Flags.FileSaverFlags] -> m ()), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverSetFlagsMethodInfo a signature where
    overloadedMethod = fileSaverSetFlags

instance O.OverloadedMethodInfo FileSaverSetFlagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverSetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverSetFlags"
        })


#endif

-- method FileSaver::set_newline_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "saver"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileSaver" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileSaver."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "newline_type"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "NewlineType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new newline type."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_saver_set_newline_type" gtk_source_file_saver_set_newline_type :: 
    Ptr FileSaver ->                        -- saver : TInterface (Name {namespace = "GtkSource", name = "FileSaver"})
    CUInt ->                                -- newline_type : TInterface (Name {namespace = "GtkSource", name = "NewlineType"})
    IO ()

-- | Sets the newline type. By default the newline type is taken from the
-- t'GI.GtkSource.Objects.File.File'.
-- 
-- /Since: 3.14/
fileSaverSetNewlineType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileSaver a) =>
    a
    -- ^ /@saver@/: a t'GI.GtkSource.Objects.FileSaver.FileSaver'.
    -> GtkSource.Enums.NewlineType
    -- ^ /@newlineType@/: the new newline type.
    -> m ()
fileSaverSetNewlineType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileSaver a) =>
a -> NewlineType -> m ()
fileSaverSetNewlineType a
saver NewlineType
newlineType = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileSaver
saver' <- a -> IO (Ptr FileSaver)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
saver
    let newlineType' :: CUInt
newlineType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (NewlineType -> Int) -> NewlineType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewlineType -> Int
forall a. Enum a => a -> Int
fromEnum) NewlineType
newlineType
    Ptr FileSaver -> CUInt -> IO ()
gtk_source_file_saver_set_newline_type Ptr FileSaver
saver' CUInt
newlineType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
saver
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileSaverSetNewlineTypeMethodInfo
instance (signature ~ (GtkSource.Enums.NewlineType -> m ()), MonadIO m, IsFileSaver a) => O.OverloadedMethod FileSaverSetNewlineTypeMethodInfo a signature where
    overloadedMethod = fileSaverSetNewlineType

instance O.OverloadedMethodInfo FileSaverSetNewlineTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.FileSaver.fileSaverSetNewlineType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.28/docs/GI-GtkSource-Objects-FileSaver.html#v:fileSaverSetNewlineType"
        })


#endif