{-# 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.FileLoader
    ( 

-- * Exported types
    FileLoader(..)                          ,
    IsFileLoader                            ,
    toFileLoader                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [loadAsync]("GI.GtkSource.Objects.FileLoader#g:method:loadAsync"), [loadFinish]("GI.GtkSource.Objects.FileLoader#g:method:loadFinish"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBuffer]("GI.GtkSource.Objects.FileLoader#g:method:getBuffer"), [getCompressionType]("GI.GtkSource.Objects.FileLoader#g:method:getCompressionType"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEncoding]("GI.GtkSource.Objects.FileLoader#g:method:getEncoding"), [getFile]("GI.GtkSource.Objects.FileLoader#g:method:getFile"), [getInputStream]("GI.GtkSource.Objects.FileLoader#g:method:getInputStream"), [getLocation]("GI.GtkSource.Objects.FileLoader#g:method:getLocation"), [getNewlineType]("GI.GtkSource.Objects.FileLoader#g:method:getNewlineType"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setCandidateEncodings]("GI.GtkSource.Objects.FileLoader#g:method:setCandidateEncodings"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFileLoaderMethod                 ,
#endif

-- ** getBuffer #method:getBuffer#

#if defined(ENABLE_OVERLOADING)
    FileLoaderGetBufferMethodInfo           ,
#endif
    fileLoaderGetBuffer                     ,


-- ** getCompressionType #method:getCompressionType#

#if defined(ENABLE_OVERLOADING)
    FileLoaderGetCompressionTypeMethodInfo  ,
#endif
    fileLoaderGetCompressionType            ,


-- ** getEncoding #method:getEncoding#

#if defined(ENABLE_OVERLOADING)
    FileLoaderGetEncodingMethodInfo         ,
#endif
    fileLoaderGetEncoding                   ,


-- ** getFile #method:getFile#

#if defined(ENABLE_OVERLOADING)
    FileLoaderGetFileMethodInfo             ,
#endif
    fileLoaderGetFile                       ,


-- ** getInputStream #method:getInputStream#

#if defined(ENABLE_OVERLOADING)
    FileLoaderGetInputStreamMethodInfo      ,
#endif
    fileLoaderGetInputStream                ,


-- ** getLocation #method:getLocation#

#if defined(ENABLE_OVERLOADING)
    FileLoaderGetLocationMethodInfo         ,
#endif
    fileLoaderGetLocation                   ,


-- ** getNewlineType #method:getNewlineType#

#if defined(ENABLE_OVERLOADING)
    FileLoaderGetNewlineTypeMethodInfo      ,
#endif
    fileLoaderGetNewlineType                ,


-- ** loadAsync #method:loadAsync#

#if defined(ENABLE_OVERLOADING)
    FileLoaderLoadAsyncMethodInfo           ,
#endif
    fileLoaderLoadAsync                     ,


-- ** loadFinish #method:loadFinish#

#if defined(ENABLE_OVERLOADING)
    FileLoaderLoadFinishMethodInfo          ,
#endif
    fileLoaderLoadFinish                    ,


-- ** new #method:new#

    fileLoaderNew                           ,


-- ** newFromStream #method:newFromStream#

    fileLoaderNewFromStream                 ,


-- ** setCandidateEncodings #method:setCandidateEncodings#

#if defined(ENABLE_OVERLOADING)
    FileLoaderSetCandidateEncodingsMethodInfo,
#endif
    fileLoaderSetCandidateEncodings         ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    FileLoaderBufferPropertyInfo            ,
#endif
    constructFileLoaderBuffer               ,
#if defined(ENABLE_OVERLOADING)
    fileLoaderBuffer                        ,
#endif
    getFileLoaderBuffer                     ,


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

#if defined(ENABLE_OVERLOADING)
    FileLoaderFilePropertyInfo              ,
#endif
    constructFileLoaderFile                 ,
#if defined(ENABLE_OVERLOADING)
    fileLoaderFile                          ,
#endif
    getFileLoaderFile                       ,


-- ** inputStream #attr:inputStream#
-- | The t'GI.Gio.Objects.InputStream.InputStream' to load. Useful for reading stdin. If this property
-- is set, the t'GI.GtkSource.Objects.FileLoader.FileLoader':@/location/@ property is ignored.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileLoaderInputStreamPropertyInfo       ,
#endif
    constructFileLoaderInputStream          ,
#if defined(ENABLE_OVERLOADING)
    fileLoaderInputStream                   ,
#endif
    getFileLoaderInputStream                ,


-- ** location #attr:location#
-- | The t'GI.Gio.Interfaces.File.File' to load. If the t'GI.GtkSource.Objects.FileLoader.FileLoader':@/input-stream/@ is
-- 'P.Nothing', by default the location is taken from the t'GI.GtkSource.Objects.File.File' at
-- construction time.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileLoaderLocationPropertyInfo          ,
#endif
    constructFileLoaderLocation             ,
#if defined(ENABLE_OVERLOADING)
    fileLoaderLocation                      ,
#endif
    getFileLoaderLocation                   ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.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 GHC.Records as R

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.GtkSource.Enums as GtkSource.Enums
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 FileLoader = FileLoader (SP.ManagedPtr FileLoader)
    deriving (FileLoader -> FileLoader -> Bool
(FileLoader -> FileLoader -> Bool)
-> (FileLoader -> FileLoader -> Bool) -> Eq FileLoader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileLoader -> FileLoader -> Bool
$c/= :: FileLoader -> FileLoader -> Bool
== :: FileLoader -> FileLoader -> Bool
$c== :: FileLoader -> FileLoader -> Bool
Eq)

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

foreign import ccall "gtk_source_file_loader_get_type"
    c_gtk_source_file_loader_get_type :: IO B.Types.GType

instance B.Types.TypedObject FileLoader where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_file_loader_get_type

instance B.Types.GObject FileLoader

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFileLoaderMethod (t :: Symbol) (o :: *) :: * where
    ResolveFileLoaderMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFileLoaderMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFileLoaderMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFileLoaderMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFileLoaderMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFileLoaderMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFileLoaderMethod "loadAsync" o = FileLoaderLoadAsyncMethodInfo
    ResolveFileLoaderMethod "loadFinish" o = FileLoaderLoadFinishMethodInfo
    ResolveFileLoaderMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFileLoaderMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFileLoaderMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFileLoaderMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFileLoaderMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFileLoaderMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFileLoaderMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFileLoaderMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFileLoaderMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFileLoaderMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFileLoaderMethod "getBuffer" o = FileLoaderGetBufferMethodInfo
    ResolveFileLoaderMethod "getCompressionType" o = FileLoaderGetCompressionTypeMethodInfo
    ResolveFileLoaderMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFileLoaderMethod "getEncoding" o = FileLoaderGetEncodingMethodInfo
    ResolveFileLoaderMethod "getFile" o = FileLoaderGetFileMethodInfo
    ResolveFileLoaderMethod "getInputStream" o = FileLoaderGetInputStreamMethodInfo
    ResolveFileLoaderMethod "getLocation" o = FileLoaderGetLocationMethodInfo
    ResolveFileLoaderMethod "getNewlineType" o = FileLoaderGetNewlineTypeMethodInfo
    ResolveFileLoaderMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFileLoaderMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFileLoaderMethod "setCandidateEncodings" o = FileLoaderSetCandidateEncodingsMethodInfo
    ResolveFileLoaderMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFileLoaderMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFileLoaderMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFileLoaderMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveFileLoaderMethod t FileLoader, O.OverloadedMethod info FileLoader p) => OL.IsLabel t (FileLoader -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveFileLoaderMethod t FileLoader, O.OverloadedMethod info FileLoader p, R.HasField t FileLoader p) => R.HasField t FileLoader p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@buffer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileLoaderBuffer :: (IsFileLoader o, MIO.MonadIO m, GtkSource.Buffer.IsBuffer a) => a -> m (GValueConstruct o)
constructFileLoaderBuffer :: forall o (m :: * -> *) a.
(IsFileLoader o, MonadIO m, IsBuffer a) =>
a -> m (GValueConstruct o)
constructFileLoaderBuffer a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"buffer" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data FileLoaderBufferPropertyInfo
instance AttrInfo FileLoaderBufferPropertyInfo where
    type AttrAllowedOps FileLoaderBufferPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileLoaderBufferPropertyInfo = IsFileLoader
    type AttrSetTypeConstraint FileLoaderBufferPropertyInfo = GtkSource.Buffer.IsBuffer
    type AttrTransferTypeConstraint FileLoaderBufferPropertyInfo = GtkSource.Buffer.IsBuffer
    type AttrTransferType FileLoaderBufferPropertyInfo = GtkSource.Buffer.Buffer
    type AttrGetType FileLoaderBufferPropertyInfo = GtkSource.Buffer.Buffer
    type AttrLabel FileLoaderBufferPropertyInfo = "buffer"
    type AttrOrigin FileLoaderBufferPropertyInfo = FileLoader
    attrGet = getFileLoaderBuffer
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo GtkSource.Buffer.Buffer v
    attrConstruct = constructFileLoaderBuffer
    attrClear = undefined
#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' fileLoader #file
-- @
getFileLoaderFile :: (MonadIO m, IsFileLoader o) => o -> m GtkSource.File.File
getFileLoaderFile :: forall (m :: * -> *) o. (MonadIO m, IsFileLoader o) => o -> m File
getFileLoaderFile o
obj = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe File) -> IO File
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getFileLoaderFile" (IO (Maybe File) -> IO File) -> IO (Maybe File) -> IO File
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr File -> File) -> IO (Maybe File)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"file" ManagedPtr File -> File
GtkSource.File.File

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

#if defined(ENABLE_OVERLOADING)
data FileLoaderFilePropertyInfo
instance AttrInfo FileLoaderFilePropertyInfo where
    type AttrAllowedOps FileLoaderFilePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileLoaderFilePropertyInfo = IsFileLoader
    type AttrSetTypeConstraint FileLoaderFilePropertyInfo = GtkSource.File.IsFile
    type AttrTransferTypeConstraint FileLoaderFilePropertyInfo = GtkSource.File.IsFile
    type AttrTransferType FileLoaderFilePropertyInfo = GtkSource.File.File
    type AttrGetType FileLoaderFilePropertyInfo = GtkSource.File.File
    type AttrLabel FileLoaderFilePropertyInfo = "file"
    type AttrOrigin FileLoaderFilePropertyInfo = FileLoader
    attrGet = getFileLoaderFile
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo GtkSource.File.File v
    attrConstruct = constructFileLoaderFile
    attrClear = undefined
#endif

-- VVV Prop "input-stream"
   -- Type: TInterface (Name {namespace = "Gio", name = "InputStream"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data FileLoaderInputStreamPropertyInfo
instance AttrInfo FileLoaderInputStreamPropertyInfo where
    type AttrAllowedOps FileLoaderInputStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileLoaderInputStreamPropertyInfo = IsFileLoader
    type AttrSetTypeConstraint FileLoaderInputStreamPropertyInfo = Gio.InputStream.IsInputStream
    type AttrTransferTypeConstraint FileLoaderInputStreamPropertyInfo = Gio.InputStream.IsInputStream
    type AttrTransferType FileLoaderInputStreamPropertyInfo = Gio.InputStream.InputStream
    type AttrGetType FileLoaderInputStreamPropertyInfo = (Maybe Gio.InputStream.InputStream)
    type AttrLabel FileLoaderInputStreamPropertyInfo = "input-stream"
    type AttrOrigin FileLoaderInputStreamPropertyInfo = FileLoader
    attrGet = getFileLoaderInputStream
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.InputStream.InputStream v
    attrConstruct = constructFileLoaderInputStream
    attrClear = undefined
#endif

-- VVV Prop "location"
   -- Type: TInterface (Name {namespace = "Gio", name = "File"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,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' fileLoader #location
-- @
getFileLoaderLocation :: (MonadIO m, IsFileLoader o) => o -> m (Maybe Gio.File.File)
getFileLoaderLocation :: forall (m :: * -> *) o.
(MonadIO m, IsFileLoader o) =>
o -> m (Maybe File)
getFileLoaderLocation o
obj = IO (Maybe File) -> m (Maybe File)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr File -> File) -> IO (Maybe File)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"location" ManagedPtr File -> File
Gio.File.File

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

#if defined(ENABLE_OVERLOADING)
data FileLoaderLocationPropertyInfo
instance AttrInfo FileLoaderLocationPropertyInfo where
    type AttrAllowedOps FileLoaderLocationPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileLoaderLocationPropertyInfo = IsFileLoader
    type AttrSetTypeConstraint FileLoaderLocationPropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint FileLoaderLocationPropertyInfo = Gio.File.IsFile
    type AttrTransferType FileLoaderLocationPropertyInfo = Gio.File.File
    type AttrGetType FileLoaderLocationPropertyInfo = (Maybe Gio.File.File)
    type AttrLabel FileLoaderLocationPropertyInfo = "location"
    type AttrOrigin FileLoaderLocationPropertyInfo = FileLoader
    attrGet = getFileLoaderLocation
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructFileLoaderLocation
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FileLoader
type instance O.AttributeList FileLoader = FileLoaderAttributeList
type FileLoaderAttributeList = ('[ '("buffer", FileLoaderBufferPropertyInfo), '("file", FileLoaderFilePropertyInfo), '("inputStream", FileLoaderInputStreamPropertyInfo), '("location", FileLoaderLocationPropertyInfo)] :: [(Symbol, *)])
#endif

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

fileLoaderFile :: AttrLabelProxy "file"
fileLoaderFile = AttrLabelProxy

fileLoaderInputStream :: AttrLabelProxy "inputStream"
fileLoaderInputStream = AttrLabelProxy

fileLoaderLocation :: AttrLabelProxy "location"
fileLoaderLocation = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList FileLoader = FileLoaderSignalList
type FileLoaderSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method FileLoader::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 load the contents into."
--                 , 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 = "FileLoader" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_loader_new" gtk_source_file_loader_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 FileLoader)

-- | Creates a new t'GI.GtkSource.Objects.FileLoader.FileLoader' object. The contents is read from the
-- t'GI.GtkSource.Objects.File.File'\'s location. If not already done, call
-- 'GI.GtkSource.Objects.File.fileSetLocation' before calling this constructor. The previous
-- location is anyway not needed, because as soon as the file loading begins,
-- the /@buffer@/ is emptied.
-- 
-- /Since: 3.14/
fileLoaderNew ::
    (B.CallStack.HasCallStack, MonadIO m, GtkSource.Buffer.IsBuffer a, GtkSource.File.IsFile b) =>
    a
    -- ^ /@buffer@/: the t'GI.GtkSource.Objects.Buffer.Buffer' to load the contents into.
    -> b
    -- ^ /@file@/: the t'GI.GtkSource.Objects.File.File'.
    -> m FileLoader
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.FileLoader.FileLoader' object.
fileLoaderNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBuffer a, IsFile b) =>
a -> b -> m FileLoader
fileLoaderNew a
buffer b
file = IO FileLoader -> m FileLoader
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileLoader -> m FileLoader) -> IO FileLoader -> m FileLoader
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 FileLoader
result <- Ptr Buffer -> Ptr File -> IO (Ptr FileLoader)
gtk_source_file_loader_new Ptr Buffer
buffer' Ptr File
file'
    Text -> Ptr FileLoader -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileLoaderNew" Ptr FileLoader
result
    FileLoader
result' <- ((ManagedPtr FileLoader -> FileLoader)
-> Ptr FileLoader -> IO FileLoader
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileLoader -> FileLoader
FileLoader) Ptr FileLoader
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
    FileLoader -> IO FileLoader
forall (m :: * -> *) a. Monad m => a -> m a
return FileLoader
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FileLoader::new_from_stream
-- 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 load the contents into."
--                 , 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 = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GInputStream to load, e.g. stdin."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "FileLoader" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_file_loader_new_from_stream" gtk_source_file_loader_new_from_stream :: 
    Ptr GtkSource.Buffer.Buffer ->          -- buffer : TInterface (Name {namespace = "GtkSource", name = "Buffer"})
    Ptr GtkSource.File.File ->              -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    Ptr Gio.InputStream.InputStream ->      -- stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    IO (Ptr FileLoader)

-- | Creates a new t'GI.GtkSource.Objects.FileLoader.FileLoader' object. The contents is read from /@stream@/.
-- 
-- /Since: 3.14/
fileLoaderNewFromStream ::
    (B.CallStack.HasCallStack, MonadIO m, GtkSource.Buffer.IsBuffer a, GtkSource.File.IsFile b, Gio.InputStream.IsInputStream c) =>
    a
    -- ^ /@buffer@/: the t'GI.GtkSource.Objects.Buffer.Buffer' to load the contents into.
    -> b
    -- ^ /@file@/: the t'GI.GtkSource.Objects.File.File'.
    -> c
    -- ^ /@stream@/: the t'GI.Gio.Objects.InputStream.InputStream' to load, e.g. stdin.
    -> m FileLoader
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.FileLoader.FileLoader' object.
fileLoaderNewFromStream :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsBuffer a, IsFile b, IsInputStream c) =>
a -> b -> c -> m FileLoader
fileLoaderNewFromStream a
buffer b
file c
stream = IO FileLoader -> m FileLoader
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileLoader -> m FileLoader) -> IO FileLoader -> m FileLoader
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 InputStream
stream' <- c -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
stream
    Ptr FileLoader
result <- Ptr Buffer -> Ptr File -> Ptr InputStream -> IO (Ptr FileLoader)
gtk_source_file_loader_new_from_stream Ptr Buffer
buffer' Ptr File
file' Ptr InputStream
stream'
    Text -> Ptr FileLoader -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileLoaderNewFromStream" Ptr FileLoader
result
    FileLoader
result' <- ((ManagedPtr FileLoader -> FileLoader)
-> Ptr FileLoader -> IO FileLoader
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileLoader -> FileLoader
FileLoader) Ptr FileLoader
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
stream
    FileLoader -> IO FileLoader
forall (m :: * -> *) a. Monad m => a -> m a
return FileLoader
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FileLoader::get_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , 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_loader_get_buffer" gtk_source_file_loader_get_buffer :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    IO (Ptr GtkSource.Buffer.Buffer)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileLoaderGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> m GtkSource.Buffer.Buffer
    -- ^ __Returns:__ the t'GI.GtkSource.Objects.Buffer.Buffer' to load the contents into.
fileLoaderGetBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileLoader a) =>
a -> m Buffer
fileLoaderGetBuffer a
loader = 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 FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    Ptr Buffer
result <- Ptr FileLoader -> IO (Ptr Buffer)
gtk_source_file_loader_get_buffer Ptr FileLoader
loader'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileLoaderGetBuffer" 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
loader
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data FileLoaderGetBufferMethodInfo
instance (signature ~ (m GtkSource.Buffer.Buffer), MonadIO m, IsFileLoader a) => O.OverloadedMethod FileLoaderGetBufferMethodInfo a signature where
    overloadedMethod = fileLoaderGetBuffer

instance O.OverloadedMethodInfo FileLoaderGetBufferMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderGetBuffer",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderGetBuffer"
        }


#endif

-- method FileLoader::get_compression_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , 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_loader_get_compression_type" gtk_source_file_loader_get_compression_type :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileLoaderGetCompressionType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> m GtkSource.Enums.CompressionType
    -- ^ __Returns:__ the detected compression type.
fileLoaderGetCompressionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileLoader a) =>
a -> m CompressionType
fileLoaderGetCompressionType a
loader = 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 FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    CUInt
result <- Ptr FileLoader -> IO CUInt
gtk_source_file_loader_get_compression_type Ptr FileLoader
loader'
    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
loader
    CompressionType -> IO CompressionType
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionType
result'

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

instance O.OverloadedMethodInfo FileLoaderGetCompressionTypeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderGetCompressionType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderGetCompressionType"
        }


#endif

-- method FileLoader::get_encoding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , 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_loader_get_encoding" gtk_source_file_loader_get_encoding :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    IO (Ptr GtkSource.Encoding.Encoding)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileLoaderGetEncoding ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> m GtkSource.Encoding.Encoding
    -- ^ __Returns:__ the detected file encoding.
fileLoaderGetEncoding :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileLoader a) =>
a -> m Encoding
fileLoaderGetEncoding a
loader = 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 FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    Ptr Encoding
result <- Ptr FileLoader -> IO (Ptr Encoding)
gtk_source_file_loader_get_encoding Ptr FileLoader
loader'
    Text -> Ptr Encoding -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileLoaderGetEncoding" Ptr Encoding
result
    Encoding
result' <- ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Encoding -> Encoding
GtkSource.Encoding.Encoding) Ptr Encoding
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
loader
    Encoding -> IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
result'

#if defined(ENABLE_OVERLOADING)
data FileLoaderGetEncodingMethodInfo
instance (signature ~ (m GtkSource.Encoding.Encoding), MonadIO m, IsFileLoader a) => O.OverloadedMethod FileLoaderGetEncodingMethodInfo a signature where
    overloadedMethod = fileLoaderGetEncoding

instance O.OverloadedMethodInfo FileLoaderGetEncodingMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderGetEncoding",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderGetEncoding"
        }


#endif

-- method FileLoader::get_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , 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_loader_get_file" gtk_source_file_loader_get_file :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    IO (Ptr GtkSource.File.File)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileLoaderGetFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> m GtkSource.File.File
    -- ^ __Returns:__ the t'GI.GtkSource.Objects.File.File'.
fileLoaderGetFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileLoader a) =>
a -> m File
fileLoaderGetFile a
loader = 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 FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    Ptr File
result <- Ptr FileLoader -> IO (Ptr File)
gtk_source_file_loader_get_file Ptr FileLoader
loader'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileLoaderGetFile" 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
loader
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data FileLoaderGetFileMethodInfo
instance (signature ~ (m GtkSource.File.File), MonadIO m, IsFileLoader a) => O.OverloadedMethod FileLoaderGetFileMethodInfo a signature where
    overloadedMethod = fileLoaderGetFile

instance O.OverloadedMethodInfo FileLoaderGetFileMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderGetFile",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderGetFile"
        }


#endif

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

foreign import ccall "gtk_source_file_loader_get_input_stream" gtk_source_file_loader_get_input_stream :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    IO (Ptr Gio.InputStream.InputStream)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileLoaderGetInputStream ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> m (Maybe Gio.InputStream.InputStream)
    -- ^ __Returns:__ the t'GI.Gio.Objects.InputStream.InputStream' to load, or 'P.Nothing'
    -- if a t'GI.Gio.Interfaces.File.File' is used.
fileLoaderGetInputStream :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileLoader a) =>
a -> m (Maybe InputStream)
fileLoaderGetInputStream a
loader = IO (Maybe InputStream) -> m (Maybe InputStream)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InputStream) -> m (Maybe InputStream))
-> IO (Maybe InputStream) -> m (Maybe InputStream)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    Ptr InputStream
result <- Ptr FileLoader -> IO (Ptr InputStream)
gtk_source_file_loader_get_input_stream Ptr FileLoader
loader'
    Maybe InputStream
maybeResult <- Ptr InputStream
-> (Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr InputStream
result ((Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream))
-> (Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream)
forall a b. (a -> b) -> a -> b
$ \Ptr InputStream
result' -> do
        InputStream
result'' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
result'
        InputStream -> IO InputStream
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
loader
    Maybe InputStream -> IO (Maybe InputStream)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InputStream
maybeResult

#if defined(ENABLE_OVERLOADING)
data FileLoaderGetInputStreamMethodInfo
instance (signature ~ (m (Maybe Gio.InputStream.InputStream)), MonadIO m, IsFileLoader a) => O.OverloadedMethod FileLoaderGetInputStreamMethodInfo a signature where
    overloadedMethod = fileLoaderGetInputStream

instance O.OverloadedMethodInfo FileLoaderGetInputStreamMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderGetInputStream",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderGetInputStream"
        }


#endif

-- method FileLoader::get_location
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , 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_loader_get_location" gtk_source_file_loader_get_location :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    IO (Ptr Gio.File.File)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileLoaderGetLocation ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the t'GI.Gio.Interfaces.File.File' to load, or 'P.Nothing'
    -- if an input stream is used.
fileLoaderGetLocation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileLoader a) =>
a -> m (Maybe File)
fileLoaderGetLocation a
loader = IO (Maybe File) -> m (Maybe File)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    Ptr File
result <- Ptr FileLoader -> IO (Ptr File)
gtk_source_file_loader_get_location Ptr FileLoader
loader'
    Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
        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'
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
loader
    Maybe File -> IO (Maybe File)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult

#if defined(ENABLE_OVERLOADING)
data FileLoaderGetLocationMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m, IsFileLoader a) => O.OverloadedMethod FileLoaderGetLocationMethodInfo a signature where
    overloadedMethod = fileLoaderGetLocation

instance O.OverloadedMethodInfo FileLoaderGetLocationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderGetLocation",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderGetLocation"
        }


#endif

-- method FileLoader::get_newline_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , 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_loader_get_newline_type" gtk_source_file_loader_get_newline_type :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileLoaderGetNewlineType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> m GtkSource.Enums.NewlineType
    -- ^ __Returns:__ the detected newline type.
fileLoaderGetNewlineType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileLoader a) =>
a -> m NewlineType
fileLoaderGetNewlineType a
loader = 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 FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    CUInt
result <- Ptr FileLoader -> IO CUInt
gtk_source_file_loader_get_newline_type Ptr FileLoader
loader'
    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
loader
    NewlineType -> IO NewlineType
forall (m :: * -> *) a. Monad m => a -> m a
return NewlineType
result'

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

instance O.OverloadedMethodInfo FileLoaderGetNewlineTypeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderGetNewlineType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderGetNewlineType"
        }


#endif

-- method FileLoader::load_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , 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_loader_load_async" gtk_source_file_loader_load_async :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    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 ()

-- | Loads asynchronously the file or input stream contents into the
-- t'GI.GtkSource.Objects.Buffer.Buffer'. See the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' documentation to know how to use this
-- function.
-- 
-- /Since: 3.14/
fileLoaderLoadAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> 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 ()
fileLoaderLoadAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileLoader a, IsCancellable b) =>
a
-> Int32
-> Maybe b
-> Maybe FileProgressCallback
-> Maybe AsyncReadyCallback
-> m ()
fileLoaderLoadAsync a
loader Int32
ioPriority Maybe b
cancellable Maybe FileProgressCallback
progressCallback 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 FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_FileProgressCallback
maybeProgressCallback <- case Maybe FileProgressCallback
progressCallback of
        Maybe FileProgressCallback
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 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
        Maybe AsyncReadyCallback
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 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 ())
SP.safeFreeFunPtrPtr
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileLoader
-> Int32
-> Ptr Cancellable
-> FunPtr C_FileProgressCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> FunPtr C_AsyncReadyCallback
-> C_DestroyNotify
gtk_source_file_loader_load_async Ptr FileLoader
loader' 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
loader
    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 FileLoaderLoadAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.FileProgressCallback) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileLoader a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileLoaderLoadAsyncMethodInfo a signature where
    overloadedMethod = fileLoaderLoadAsync

instance O.OverloadedMethodInfo FileLoaderLoadAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderLoadAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderLoadAsync"
        }


#endif

-- method FileLoader::load_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , 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_loader_load_finish" gtk_source_file_loader_load_finish :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a file loading started with 'GI.GtkSource.Objects.FileLoader.fileLoaderLoadAsync'.
-- 
-- If the contents has been loaded, the following t'GI.GtkSource.Objects.File.File' properties will
-- be updated: the location, the encoding, the newline type and the compression
-- type.
-- 
-- /Since: 3.14/
fileLoaderLoadFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileLoaderLoadFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileLoader a, IsAsyncResult b) =>
a -> b -> m ()
fileLoaderLoadFinish a
loader 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 FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    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 FileLoader -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
gtk_source_file_loader_load_finish Ptr FileLoader
loader' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
loader
        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 FileLoaderLoadFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFileLoader a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileLoaderLoadFinishMethodInfo a signature where
    overloadedMethod = fileLoaderLoadFinish

instance O.OverloadedMethodInfo FileLoaderLoadFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderLoadFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderLoadFinish"
        }


#endif

-- method FileLoader::set_candidate_encodings
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loader"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "FileLoader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFileLoader."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "candidate_encodings"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "GtkSource" , name = "Encoding" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a list of\n  #GtkSourceEncoding<!-- -->s."
--                 , 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_loader_set_candidate_encodings" gtk_source_file_loader_set_candidate_encodings :: 
    Ptr FileLoader ->                       -- loader : TInterface (Name {namespace = "GtkSource", name = "FileLoader"})
    Ptr (GSList (Ptr GtkSource.Encoding.Encoding)) -> -- candidate_encodings : TGSList (TInterface (Name {namespace = "GtkSource", name = "Encoding"}))
    IO ()

-- | Sets the candidate encodings for the file loading. The encodings are tried in
-- the same order as the list.
-- 
-- For convenience, /@candidateEncodings@/ can contain duplicates. Only the first
-- occurrence of a duplicated encoding is kept in the list.
-- 
-- By default the candidate encodings are (in that order in the list):
-- 1. If set, the t'GI.GtkSource.Objects.File.File'\'s encoding as returned by
-- 'GI.GtkSource.Objects.File.fileGetEncoding'.
-- 2. The default candidates as returned by
-- 'GI.GtkSource.Functions.encodingGetDefaultCandidates'.
-- 
-- /Since: 3.14/
fileLoaderSetCandidateEncodings ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileLoader a) =>
    a
    -- ^ /@loader@/: a t'GI.GtkSource.Objects.FileLoader.FileLoader'.
    -> [GtkSource.Encoding.Encoding]
    -- ^ /@candidateEncodings@/: a list of
    --   t'GI.GtkSource.Structs.Encoding.Encoding's.
    -> m ()
fileLoaderSetCandidateEncodings :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileLoader a) =>
a -> [Encoding] -> m ()
fileLoaderSetCandidateEncodings a
loader [Encoding]
candidateEncodings = 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 FileLoader
loader' <- a -> IO (Ptr FileLoader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
loader
    [Ptr Encoding]
candidateEncodings' <- (Encoding -> IO (Ptr Encoding)) -> [Encoding] -> IO [Ptr Encoding]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Encoding -> IO (Ptr Encoding)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Encoding]
candidateEncodings
    Ptr (GSList (Ptr Encoding))
candidateEncodings'' <- [Ptr Encoding] -> IO (Ptr (GSList (Ptr Encoding)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr Encoding]
candidateEncodings'
    Ptr FileLoader -> Ptr (GSList (Ptr Encoding)) -> IO ()
gtk_source_file_loader_set_candidate_encodings Ptr FileLoader
loader' Ptr (GSList (Ptr Encoding))
candidateEncodings''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
loader
    (Encoding -> IO ()) -> [Encoding] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Encoding -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Encoding]
candidateEncodings
    Ptr (GSList (Ptr Encoding)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Encoding))
candidateEncodings''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileLoaderSetCandidateEncodingsMethodInfo
instance (signature ~ ([GtkSource.Encoding.Encoding] -> m ()), MonadIO m, IsFileLoader a) => O.OverloadedMethod FileLoaderSetCandidateEncodingsMethodInfo a signature where
    overloadedMethod = fileLoaderSetCandidateEncodings

instance O.OverloadedMethodInfo FileLoaderSetCandidateEncodingsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GtkSource.Objects.FileLoader.fileLoaderSetCandidateEncodings",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.24/docs/GI-GtkSource-Objects-FileLoader.html#v:fileLoaderSetCandidateEncodings"
        }


#endif