{-# LANGUAGE TypeApplications #-}


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


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

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

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 (ManagedPtr FileSaver)
    deriving (FileSaver -> FileSaver -> Bool
(FileSaver -> FileSaver -> Bool)
-> (FileSaver -> FileSaver -> Bool) -> Eq FileSaver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSaver -> FileSaver -> Bool
$c/= :: FileSaver -> FileSaver -> Bool
== :: FileSaver -> FileSaver -> Bool
$c== :: FileSaver -> FileSaver -> Bool
Eq)
foreign import ccall "gtk_source_file_saver_get_type"
    c_gtk_source_file_saver_get_type :: IO GType

instance GObject FileSaver where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_source_file_saver_get_type
    

-- | Convert 'FileSaver' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue FileSaver where
    toGValue :: FileSaver -> IO GValue
toGValue o :: FileSaver
o = do
        GType
gtype <- IO GType
c_gtk_source_file_saver_get_type
        FileSaver -> (Ptr FileSaver -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FileSaver
o (GType
-> (GValue -> Ptr FileSaver -> IO ()) -> Ptr FileSaver -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr FileSaver -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO FileSaver
fromGValue gv :: GValue
gv = do
        Ptr FileSaver
ptr <- GValue -> IO (Ptr FileSaver)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr FileSaver)
        (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
        
    

-- | Type class for types which can be safely cast to `FileSaver`, for instance with `toFileSaver`.
class (GObject o, O.IsDescendantOf FileSaver o) => IsFileSaver o
instance (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 :: (MonadIO m, IsFileSaver o) => o -> m FileSaver
toFileSaver :: o -> m FileSaver
toFileSaver = IO FileSaver -> m FileSaver
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr FileSaver -> FileSaver
FileSaver

-- | A convenience alias for `Nothing` :: `Maybe` `FileSaver`.
noFileSaver :: Maybe FileSaver
noFileSaver :: Maybe FileSaver
noFileSaver = Maybe FileSaver
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveFileSaverMethod (t :: Symbol) (o :: *) :: * 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.MethodInfo 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

#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 :: o -> m Buffer
getFileSaverBuffer obj :: o
obj = IO Buffer -> m Buffer
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
$ Text -> IO (Maybe Buffer) -> IO Buffer
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "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 "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, GtkSource.Buffer.IsBuffer a) => a -> IO (GValueConstruct o)
constructFileSaverBuffer :: a -> IO (GValueConstruct o)
constructFileSaverBuffer val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "buffer" (a -> Maybe a
forall a. a -> Maybe a
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
#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 :: o -> m CompressionType
getFileSaverCompressionType obj :: o
obj = IO CompressionType -> m CompressionType
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
$ o -> String -> IO CompressionType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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 :: o -> CompressionType -> m ()
setFileSaverCompressionType obj :: o
obj val :: CompressionType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> CompressionType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj "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) => GtkSource.Enums.CompressionType -> IO (GValueConstruct o)
constructFileSaverCompressionType :: CompressionType -> IO (GValueConstruct o)
constructFileSaverCompressionType val :: CompressionType
val = String -> CompressionType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "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
#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 :: o -> m Encoding
getFileSaverEncoding obj :: o
obj = IO Encoding -> m Encoding
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
$ Text -> IO (Maybe Encoding) -> IO Encoding
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "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, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj "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 :: o -> Encoding -> m ()
setFileSaverEncoding obj :: o
obj val :: Encoding
val = IO () -> m ()
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, BoxedObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj "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) => GtkSource.Encoding.Encoding -> IO (GValueConstruct o)
constructFileSaverEncoding :: Encoding -> IO (GValueConstruct o)
constructFileSaverEncoding val :: Encoding
val = String -> Maybe Encoding -> IO (GValueConstruct o)
forall a o.
BoxedObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed "encoding" (Encoding -> Maybe Encoding
forall a. a -> Maybe a
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 :: o -> m ()
clearFileSaverEncoding obj :: o
obj = IO () -> m ()
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, BoxedObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj "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
#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 :: o -> m File
getFileSaverFile obj :: o
obj = IO File -> m File
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
$ Text -> IO (Maybe File) -> IO File
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "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 "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, GtkSource.File.IsFile a) => a -> IO (GValueConstruct o)
constructFileSaverFile :: a -> IO (GValueConstruct o)
constructFileSaverFile val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "file" (a -> Maybe a
forall a. a -> Maybe a
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
#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 :: o -> m [FileSaverFlags]
getFileSaverFlags obj :: o
obj = IO [FileSaverFlags] -> m [FileSaverFlags]
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
$ o -> String -> IO [FileSaverFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj "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 :: o -> [FileSaverFlags] -> m ()
setFileSaverFlags obj :: o
obj val :: [FileSaverFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> [FileSaverFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj "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) => [GtkSource.Flags.FileSaverFlags] -> IO (GValueConstruct o)
constructFileSaverFlags :: [FileSaverFlags] -> IO (GValueConstruct o)
constructFileSaverFlags val :: [FileSaverFlags]
val = String -> [FileSaverFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags "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
#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 :: o -> m File
getFileSaverLocation obj :: o
obj = IO File -> m File
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
$ Text -> IO (Maybe File) -> IO File
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "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 "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, Gio.File.IsFile a) => a -> IO (GValueConstruct o)
constructFileSaverLocation :: a -> IO (GValueConstruct o)
constructFileSaverLocation val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "location" (a -> Maybe a
forall a. a -> Maybe a
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
#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 :: o -> m NewlineType
getFileSaverNewlineType obj :: o
obj = IO NewlineType -> m NewlineType
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
$ o -> String -> IO NewlineType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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 :: o -> NewlineType -> m ()
setFileSaverNewlineType obj :: o
obj val :: NewlineType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> NewlineType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj "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) => GtkSource.Enums.NewlineType -> IO (GValueConstruct o)
constructFileSaverNewlineType :: NewlineType -> IO (GValueConstruct o)
constructFileSaverNewlineType val :: NewlineType
val = String -> NewlineType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "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
#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, *)])
#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, *)])

#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' t'GI.GtkSource.Objects.File.File':@/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 :: a -> b -> m FileSaver
fileSaverNew buffer :: a
buffer file :: b
file = IO FileSaver -> m FileSaver
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 "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 (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
-- t'GI.GtkSource.Objects.File.File':@/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 :: a -> b -> c -> m FileSaver
fileSaverNewWithTarget buffer :: a
buffer file :: b
file targetLocation :: c
targetLocation = IO FileSaver -> m FileSaver
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 "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 (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 :: a -> m Buffer
fileSaverGetBuffer saver :: a
saver = IO Buffer -> m Buffer
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 "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 (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.MethodInfo FileSaverGetBufferMethodInfo a signature where
    overloadedMethod = 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 :: a -> m CompressionType
fileSaverGetCompressionType saver :: a
saver = IO CompressionType -> m CompressionType
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 (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.MethodInfo FileSaverGetCompressionTypeMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Encoding
fileSaverGetEncoding saver :: a
saver = IO Encoding -> m Encoding
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 "fileSaverGetEncoding" Ptr Encoding
result
    Encoding
result' <- ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, BoxedObject 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 (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.MethodInfo FileSaverGetEncodingMethodInfo a signature where
    overloadedMethod = 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 :: a -> m File
fileSaverGetFile saver :: a
saver = IO File -> m File
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 "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 (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.MethodInfo FileSaverGetFileMethodInfo a signature where
    overloadedMethod = 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 :: a -> m [FileSaverFlags]
fileSaverGetFlags saver :: a
saver = IO [FileSaverFlags] -> m [FileSaverFlags]
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 (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.MethodInfo FileSaverGetFlagsMethodInfo a signature where
    overloadedMethod = 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 :: a -> m File
fileSaverGetLocation saver :: a
saver = IO File -> m File
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 "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 (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.MethodInfo FileSaverGetLocationMethodInfo a signature where
    overloadedMethod = 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 :: a -> m NewlineType
fileSaverGetNewlineType saver :: a
saver = IO NewlineType -> m NewlineType
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 (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.MethodInfo FileSaverGetNewlineTypeMethodInfo a signature where
    overloadedMethod = 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 :: a
-> Int32
-> Maybe b
-> Maybe FileProgressCallback
-> Maybe AsyncReadyCallback
-> m ()
fileSaverSaveAsync saver :: a
saver ioPriority :: Int32
ioPriority cancellable :: Maybe b
cancellable progressCallback :: Maybe FileProgressCallback
progressCallback callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_FileProgressCallback
maybeProgressCallback <- case Maybe FileProgressCallback
progressCallback of
        Nothing -> FunPtr C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_FileProgressCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jProgressCallback :: FileProgressCallback
jProgressCallback -> do
            FunPtr C_FileProgressCallback
jProgressCallback' <- C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
Gio.Callbacks.mk_FileProgressCallback (Maybe (Ptr (FunPtr C_FileProgressCallback))
-> C_FileProgressCallback -> C_FileProgressCallback
Gio.Callbacks.wrap_FileProgressCallback Maybe (Ptr (FunPtr C_FileProgressCallback))
forall a. Maybe a
Nothing (FileProgressCallback -> C_FileProgressCallback
Gio.Callbacks.drop_closures_FileProgressCallback FileProgressCallback
jProgressCallback))
            FunPtr C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_FileProgressCallback
jProgressCallback'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
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 jCallback :: 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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let progressCallbackData :: Ptr ()
progressCallbackData = FunPtr C_FileProgressCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_FileProgressCallback
maybeProgressCallback
    let progressCallbackNotify :: FunPtr (Ptr a -> IO ())
progressCallbackNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileSaver
-> Int32
-> Ptr Cancellable
-> FunPtr C_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 C_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 (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.MethodInfo FileSaverSaveAsyncMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m ()
fileSaverSaveFinish saver :: a
saver result_ :: b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
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.MethodInfo FileSaverSaveFinishMethodInfo a signature where
    overloadedMethod = 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 :: a -> CompressionType -> m ()
fileSaverSetCompressionType saver :: a
saver compressionType :: CompressionType
compressionType = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo FileSaverSetCompressionTypeMethodInfo a signature where
    overloadedMethod = 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 :: a -> Maybe Encoding -> m ()
fileSaverSetEncoding saver :: a
saver encoding :: Maybe Encoding
encoding = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Nothing -> Ptr Encoding -> IO (Ptr Encoding)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Encoding
forall a. Ptr a
nullPtr
        Just jEncoding :: 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 (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 (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.MethodInfo FileSaverSetEncodingMethodInfo a signature where
    overloadedMethod = 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 :: a -> [FileSaverFlags] -> m ()
fileSaverSetFlags saver :: a
saver flags :: [FileSaverFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo FileSaverSetFlagsMethodInfo a signature where
    overloadedMethod = 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 :: a -> NewlineType -> m ()
fileSaverSetNewlineType saver :: a
saver newlineType :: NewlineType
newlineType = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo FileSaverSetNewlineTypeMethodInfo a signature where
    overloadedMethod = fileSaverSetNewlineType

#endif