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

-- * Exported types
    File(..)                                ,
    IsFile                                  ,
    toFile                                  ,
    noFile                                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFileMethod                       ,
#endif


-- ** checkFileOnDisk #method:checkFileOnDisk#

#if defined(ENABLE_OVERLOADING)
    FileCheckFileOnDiskMethodInfo           ,
#endif
    fileCheckFileOnDisk                     ,


-- ** getCompressionType #method:getCompressionType#

#if defined(ENABLE_OVERLOADING)
    FileGetCompressionTypeMethodInfo        ,
#endif
    fileGetCompressionType                  ,


-- ** getEncoding #method:getEncoding#

#if defined(ENABLE_OVERLOADING)
    FileGetEncodingMethodInfo               ,
#endif
    fileGetEncoding                         ,


-- ** getLocation #method:getLocation#

#if defined(ENABLE_OVERLOADING)
    FileGetLocationMethodInfo               ,
#endif
    fileGetLocation                         ,


-- ** getNewlineType #method:getNewlineType#

#if defined(ENABLE_OVERLOADING)
    FileGetNewlineTypeMethodInfo            ,
#endif
    fileGetNewlineType                      ,


-- ** isDeleted #method:isDeleted#

#if defined(ENABLE_OVERLOADING)
    FileIsDeletedMethodInfo                 ,
#endif
    fileIsDeleted                           ,


-- ** isExternallyModified #method:isExternallyModified#

#if defined(ENABLE_OVERLOADING)
    FileIsExternallyModifiedMethodInfo      ,
#endif
    fileIsExternallyModified                ,


-- ** isLocal #method:isLocal#

#if defined(ENABLE_OVERLOADING)
    FileIsLocalMethodInfo                   ,
#endif
    fileIsLocal                             ,


-- ** isReadonly #method:isReadonly#

#if defined(ENABLE_OVERLOADING)
    FileIsReadonlyMethodInfo                ,
#endif
    fileIsReadonly                          ,


-- ** new #method:new#

    fileNew                                 ,


-- ** setLocation #method:setLocation#

#if defined(ENABLE_OVERLOADING)
    FileSetLocationMethodInfo               ,
#endif
    fileSetLocation                         ,




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

#if defined(ENABLE_OVERLOADING)
    FileCompressionTypePropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    fileCompressionType                     ,
#endif
    getFileCompressionType                  ,


-- ** encoding #attr:encoding#
-- | The character encoding, initially 'P.Nothing'. After a successful file
-- loading or saving operation, the encoding is non-'P.Nothing'.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileEncodingPropertyInfo                ,
#endif
#if defined(ENABLE_OVERLOADING)
    fileEncoding                            ,
#endif
    getFileEncoding                         ,


-- ** location #attr:location#
-- | The location.
-- 
-- /Since: 3.14/

#if defined(ENABLE_OVERLOADING)
    FileLocationPropertyInfo                ,
#endif
    clearFileLocation                       ,
    constructFileLocation                   ,
#if defined(ENABLE_OVERLOADING)
    fileLocation                            ,
#endif
    getFileLocation                         ,
    setFileLocation                         ,


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

#if defined(ENABLE_OVERLOADING)
    FileNewlineTypePropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    fileNewlineType                         ,
#endif
    getFileNewlineType                      ,


-- ** readOnly #attr:readOnly#
-- | Whether the file is read-only or not. The value of this property is
-- not updated automatically (there is no file monitors).
-- 
-- /Since: 3.18/

#if defined(ENABLE_OVERLOADING)
    FileReadOnlyPropertyInfo                ,
#endif
#if defined(ENABLE_OVERLOADING)
    fileReadOnly                            ,
#endif
    getFileReadOnly                         ,




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

-- | Memory-managed wrapper type.
newtype File = File (ManagedPtr File)
    deriving (File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq)
foreign import ccall "gtk_source_file_get_type"
    c_gtk_source_file_get_type :: IO GType

instance GObject File where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_source_file_get_type
    

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

-- | Type class for types which can be safely cast to `File`, for instance with `toFile`.
class (GObject o, O.IsDescendantOf File o) => IsFile o
instance (GObject o, O.IsDescendantOf File o) => IsFile o

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

-- | Cast to `File`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toFile :: (MonadIO m, IsFile o) => o -> m File
toFile :: o -> m File
toFile = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> (o -> IO File) -> o -> m File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr File -> File) -> o -> IO File
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr File -> File
File

-- | A convenience alias for `Nothing` :: `Maybe` `File`.
noFile :: Maybe File
noFile :: Maybe File
noFile = Maybe File
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveFileMethod (t :: Symbol) (o :: *) :: * where
    ResolveFileMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFileMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFileMethod "checkFileOnDisk" o = FileCheckFileOnDiskMethodInfo
    ResolveFileMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFileMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFileMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFileMethod "isDeleted" o = FileIsDeletedMethodInfo
    ResolveFileMethod "isExternallyModified" o = FileIsExternallyModifiedMethodInfo
    ResolveFileMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFileMethod "isLocal" o = FileIsLocalMethodInfo
    ResolveFileMethod "isReadonly" o = FileIsReadonlyMethodInfo
    ResolveFileMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFileMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFileMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFileMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFileMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFileMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFileMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFileMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFileMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFileMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFileMethod "getCompressionType" o = FileGetCompressionTypeMethodInfo
    ResolveFileMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFileMethod "getEncoding" o = FileGetEncodingMethodInfo
    ResolveFileMethod "getLocation" o = FileGetLocationMethodInfo
    ResolveFileMethod "getNewlineType" o = FileGetNewlineTypeMethodInfo
    ResolveFileMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFileMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFileMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFileMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFileMethod "setLocation" o = FileSetLocationMethodInfo
    ResolveFileMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFileMethod l o = O.MethodResolutionFailed l o

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

#endif

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

-- | 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' file #compressionType
-- @
getFileCompressionType :: (MonadIO m, IsFile o) => o -> m GtkSource.Enums.CompressionType
getFileCompressionType :: o -> m CompressionType
getFileCompressionType 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"

#if defined(ENABLE_OVERLOADING)
data FileCompressionTypePropertyInfo
instance AttrInfo FileCompressionTypePropertyInfo where
    type AttrAllowedOps FileCompressionTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint FileCompressionTypePropertyInfo = IsFile
    type AttrSetTypeConstraint FileCompressionTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint FileCompressionTypePropertyInfo = (~) ()
    type AttrTransferType FileCompressionTypePropertyInfo = ()
    type AttrGetType FileCompressionTypePropertyInfo = GtkSource.Enums.CompressionType
    type AttrLabel FileCompressionTypePropertyInfo = "compression-type"
    type AttrOrigin FileCompressionTypePropertyInfo = File
    attrGet = getFileCompressionType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | 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' file #encoding
-- @
getFileEncoding :: (MonadIO m, IsFile o) => o -> m GtkSource.Encoding.Encoding
getFileEncoding :: o -> m Encoding
getFileEncoding 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 "getFileEncoding" (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

#if defined(ENABLE_OVERLOADING)
data FileEncodingPropertyInfo
instance AttrInfo FileEncodingPropertyInfo where
    type AttrAllowedOps FileEncodingPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileEncodingPropertyInfo = IsFile
    type AttrSetTypeConstraint FileEncodingPropertyInfo = (~) ()
    type AttrTransferTypeConstraint FileEncodingPropertyInfo = (~) ()
    type AttrTransferType FileEncodingPropertyInfo = ()
    type AttrGetType FileEncodingPropertyInfo = GtkSource.Encoding.Encoding
    type AttrLabel FileEncodingPropertyInfo = "encoding"
    type AttrOrigin FileEncodingPropertyInfo = File
    attrGet = getFileEncoding
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | 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' file #location
-- @
getFileLocation :: (MonadIO m, IsFile o) => o -> m Gio.File.File
getFileLocation :: o -> m File
getFileLocation 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 "getFileLocation" (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

-- | Set 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.set' file [ #location 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileLocation :: (MonadIO m, IsFile o, Gio.File.IsFile a) => o -> a -> m ()
setFileLocation :: o -> a -> m ()
setFileLocation obj :: o
obj val :: a
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 a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "location" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | 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`.
constructFileLocation :: (IsFile o, Gio.File.IsFile a) => a -> IO (GValueConstruct o)
constructFileLocation :: a -> IO (GValueConstruct o)
constructFileLocation 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)

-- | Set the value of the “@location@” 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' #location
-- @
clearFileLocation :: (MonadIO m, IsFile o) => o -> m ()
clearFileLocation :: o -> m ()
clearFileLocation 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 File -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "location" (Maybe File
forall a. Maybe a
Nothing :: Maybe Gio.File.File)

#if defined(ENABLE_OVERLOADING)
data FileLocationPropertyInfo
instance AttrInfo FileLocationPropertyInfo where
    type AttrAllowedOps FileLocationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileLocationPropertyInfo = IsFile
    type AttrSetTypeConstraint FileLocationPropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint FileLocationPropertyInfo = Gio.File.IsFile
    type AttrTransferType FileLocationPropertyInfo = Gio.File.File
    type AttrGetType FileLocationPropertyInfo = Gio.File.File
    type AttrLabel FileLocationPropertyInfo = "location"
    type AttrOrigin FileLocationPropertyInfo = File
    attrGet = getFileLocation
    attrSet = setFileLocation
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructFileLocation
    attrClear = clearFileLocation
#endif

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

-- | 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' file #newlineType
-- @
getFileNewlineType :: (MonadIO m, IsFile o) => o -> m GtkSource.Enums.NewlineType
getFileNewlineType :: o -> m NewlineType
getFileNewlineType 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"

#if defined(ENABLE_OVERLOADING)
data FileNewlineTypePropertyInfo
instance AttrInfo FileNewlineTypePropertyInfo where
    type AttrAllowedOps FileNewlineTypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint FileNewlineTypePropertyInfo = IsFile
    type AttrSetTypeConstraint FileNewlineTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint FileNewlineTypePropertyInfo = (~) ()
    type AttrTransferType FileNewlineTypePropertyInfo = ()
    type AttrGetType FileNewlineTypePropertyInfo = GtkSource.Enums.NewlineType
    type AttrLabel FileNewlineTypePropertyInfo = "newline-type"
    type AttrOrigin FileNewlineTypePropertyInfo = File
    attrGet = getFileNewlineType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "read-only"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@read-only@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' file #readOnly
-- @
getFileReadOnly :: (MonadIO m, IsFile o) => o -> m Bool
getFileReadOnly :: o -> m Bool
getFileReadOnly obj :: o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "read-only"

#if defined(ENABLE_OVERLOADING)
data FileReadOnlyPropertyInfo
instance AttrInfo FileReadOnlyPropertyInfo where
    type AttrAllowedOps FileReadOnlyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint FileReadOnlyPropertyInfo = IsFile
    type AttrSetTypeConstraint FileReadOnlyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint FileReadOnlyPropertyInfo = (~) ()
    type AttrTransferType FileReadOnlyPropertyInfo = ()
    type AttrGetType FileReadOnlyPropertyInfo = Bool
    type AttrLabel FileReadOnlyPropertyInfo = "read-only"
    type AttrOrigin FileReadOnlyPropertyInfo = File
    attrGet = getFileReadOnly
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList File
type instance O.AttributeList File = FileAttributeList
type FileAttributeList = ('[ '("compressionType", FileCompressionTypePropertyInfo), '("encoding", FileEncodingPropertyInfo), '("location", FileLocationPropertyInfo), '("newlineType", FileNewlineTypePropertyInfo), '("readOnly", FileReadOnlyPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
fileCompressionType :: AttrLabelProxy "compressionType"
fileCompressionType = AttrLabelProxy

fileEncoding :: AttrLabelProxy "encoding"
fileEncoding = AttrLabelProxy

fileLocation :: AttrLabelProxy "location"
fileLocation = AttrLabelProxy

fileNewlineType :: AttrLabelProxy "newlineType"
fileNewlineType = AttrLabelProxy

fileReadOnly :: AttrLabelProxy "readOnly"
fileReadOnly = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gtk_source_file_new" gtk_source_file_new :: 
    IO (Ptr File)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
fileNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m File
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.File.File' object.
fileNew :: m File
fileNew  = 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 File
result <- IO (Ptr File)
gtk_source_file_new
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fileNew" 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
wrapObject ManagedPtr File -> File
File) Ptr File
result
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method File::check_file_on_disk
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFile." , 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_check_file_on_disk" gtk_source_file_check_file_on_disk :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    IO ()

-- | Checks synchronously the file on disk, to know whether the file is externally
-- modified, or has been deleted, and whether the file is read-only.
-- 
-- t'GI.GtkSource.Objects.File.File' doesn\'t create a t'GI.Gio.Objects.FileMonitor.FileMonitor' to track those properties, so
-- this function needs to be called instead. Creating lots of t'GI.Gio.Objects.FileMonitor.FileMonitor'\'s
-- would take lots of resources.
-- 
-- Since this function is synchronous, it is advised to call it only on local
-- files. See 'GI.GtkSource.Objects.File.fileIsLocal'.
-- 
-- /Since: 3.18/
fileCheckFileOnDisk ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: a t'GI.GtkSource.Objects.File.File'.
    -> m ()
fileCheckFileOnDisk :: a -> m ()
fileCheckFileOnDisk file :: a
file = 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 File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr File -> IO ()
gtk_source_file_check_file_on_disk Ptr File
file'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileCheckFileOnDiskMethodInfo
instance (signature ~ (m ()), MonadIO m, IsFile a) => O.MethodInfo FileCheckFileOnDiskMethodInfo a signature where
    overloadedMethod = fileCheckFileOnDisk

#endif

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

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

#if defined(ENABLE_OVERLOADING)
data FileGetCompressionTypeMethodInfo
instance (signature ~ (m GtkSource.Enums.CompressionType), MonadIO m, IsFile a) => O.MethodInfo FileGetCompressionTypeMethodInfo a signature where
    overloadedMethod = fileGetCompressionType

#endif

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

-- | The encoding is initially 'P.Nothing'. After a successful file loading or saving
-- operation, the encoding is non-'P.Nothing'.
-- 
-- /Since: 3.14/
fileGetEncoding ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: a t'GI.GtkSource.Objects.File.File'.
    -> m GtkSource.Encoding.Encoding
    -- ^ __Returns:__ the character encoding.
fileGetEncoding :: a -> m Encoding
fileGetEncoding file :: a
file = 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 File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Encoding
result <- Ptr File -> IO (Ptr Encoding)
gtk_source_file_get_encoding Ptr File
file'
    Text -> Ptr Encoding -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fileGetEncoding" 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
file
    Encoding -> IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
result'

#if defined(ENABLE_OVERLOADING)
data FileGetEncodingMethodInfo
instance (signature ~ (m GtkSource.Encoding.Encoding), MonadIO m, IsFile a) => O.MethodInfo FileGetEncodingMethodInfo a signature where
    overloadedMethod = fileGetEncoding

#endif

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

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

#if defined(ENABLE_OVERLOADING)
data FileGetLocationMethodInfo
instance (signature ~ (m Gio.File.File), MonadIO m, IsFile a) => O.MethodInfo FileGetLocationMethodInfo a signature where
    overloadedMethod = fileGetLocation

#endif

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

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

#if defined(ENABLE_OVERLOADING)
data FileGetNewlineTypeMethodInfo
instance (signature ~ (m GtkSource.Enums.NewlineType), MonadIO m, IsFile a) => O.MethodInfo FileGetNewlineTypeMethodInfo a signature where
    overloadedMethod = fileGetNewlineType

#endif

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

foreign import ccall "gtk_source_file_is_deleted" gtk_source_file_is_deleted :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    IO CInt

-- | Returns whether the file has been deleted. If the
-- t'GI.GtkSource.Objects.File.File':@/location/@ is 'P.Nothing', returns 'P.False'.
-- 
-- To have an up-to-date value, you must first call
-- 'GI.GtkSource.Objects.File.fileCheckFileOnDisk'.
-- 
-- /Since: 3.18/
fileIsDeleted ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: a t'GI.GtkSource.Objects.File.File'.
    -> m Bool
    -- ^ __Returns:__ whether the file has been deleted.
fileIsDeleted :: a -> m Bool
fileIsDeleted file :: a
file = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CInt
result <- Ptr File -> IO CInt
gtk_source_file_is_deleted Ptr File
file'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileIsDeletedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFile a) => O.MethodInfo FileIsDeletedMethodInfo a signature where
    overloadedMethod = fileIsDeleted

#endif

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

foreign import ccall "gtk_source_file_is_externally_modified" gtk_source_file_is_externally_modified :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    IO CInt

-- | Returns whether the file is externally modified. If the
-- t'GI.GtkSource.Objects.File.File':@/location/@ is 'P.Nothing', returns 'P.False'.
-- 
-- To have an up-to-date value, you must first call
-- 'GI.GtkSource.Objects.File.fileCheckFileOnDisk'.
-- 
-- /Since: 3.18/
fileIsExternallyModified ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: a t'GI.GtkSource.Objects.File.File'.
    -> m Bool
    -- ^ __Returns:__ whether the file is externally modified.
fileIsExternallyModified :: a -> m Bool
fileIsExternallyModified file :: a
file = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CInt
result <- Ptr File -> IO CInt
gtk_source_file_is_externally_modified Ptr File
file'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileIsExternallyModifiedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFile a) => O.MethodInfo FileIsExternallyModifiedMethodInfo a signature where
    overloadedMethod = fileIsExternallyModified

#endif

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

foreign import ccall "gtk_source_file_is_local" gtk_source_file_is_local :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    IO CInt

-- | Returns whether the file is local. If the t'GI.GtkSource.Objects.File.File':@/location/@ is 'P.Nothing',
-- returns 'P.False'.
-- 
-- /Since: 3.18/
fileIsLocal ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: a t'GI.GtkSource.Objects.File.File'.
    -> m Bool
    -- ^ __Returns:__ whether the file is local.
fileIsLocal :: a -> m Bool
fileIsLocal file :: a
file = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CInt
result <- Ptr File -> IO CInt
gtk_source_file_is_local Ptr File
file'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileIsLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFile a) => O.MethodInfo FileIsLocalMethodInfo a signature where
    overloadedMethod = fileIsLocal

#endif

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

foreign import ccall "gtk_source_file_is_readonly" gtk_source_file_is_readonly :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    IO CInt

-- | Returns whether the file is read-only. If the
-- t'GI.GtkSource.Objects.File.File':@/location/@ is 'P.Nothing', returns 'P.False'.
-- 
-- To have an up-to-date value, you must first call
-- 'GI.GtkSource.Objects.File.fileCheckFileOnDisk'.
-- 
-- /Since: 3.18/
fileIsReadonly ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: a t'GI.GtkSource.Objects.File.File'.
    -> m Bool
    -- ^ __Returns:__ whether the file is read-only.
fileIsReadonly :: a -> m Bool
fileIsReadonly file :: a
file = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CInt
result <- Ptr File -> IO CInt
gtk_source_file_is_readonly Ptr File
file'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileIsReadonlyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFile a) => O.MethodInfo FileIsReadonlyMethodInfo a signature where
    overloadedMethod = fileIsReadonly

#endif

-- method File::set_location
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceFile." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "location"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new #GFile, or %NULL."
--                 , 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_set_location" gtk_source_file_set_location :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "GtkSource", name = "File"})
    Ptr Gio.File.File ->                    -- location : TInterface (Name {namespace = "Gio", name = "File"})
    IO ()

-- | Sets the location.
-- 
-- /Since: 3.14/
fileSetLocation ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.File.IsFile b) =>
    a
    -- ^ /@file@/: a t'GI.GtkSource.Objects.File.File'.
    -> Maybe (b)
    -- ^ /@location@/: the new t'GI.Gio.Interfaces.File.File', or 'P.Nothing'.
    -> m ()
fileSetLocation :: a -> Maybe b -> m ()
fileSetLocation file :: a
file location :: Maybe b
location = 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 File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr File
maybeLocation <- case Maybe b
location of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jLocation :: b
jLocation -> do
            Ptr File
jLocation' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jLocation
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jLocation'
    Ptr File -> Ptr File -> IO ()
gtk_source_file_set_location Ptr File
file' Ptr File
maybeLocation
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
location b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileSetLocationMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.File.IsFile b) => O.MethodInfo FileSetLocationMethodInfo a signature where
    overloadedMethod = fileSetLocation

#endif