{-# LANGUAGE TypeApplications #-}


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

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

module GI.GtkSource.Structs.Encoding
    ( 

-- * Exported types
    Encoding(..)                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.GtkSource.Structs.Encoding#g:method:copy"), [free]("GI.GtkSource.Structs.Encoding#g:method:free"), [toString]("GI.GtkSource.Structs.Encoding#g:method:toString").
-- 
-- ==== Getters
-- [getCharset]("GI.GtkSource.Structs.Encoding#g:method:getCharset"), [getName]("GI.GtkSource.Structs.Encoding#g:method:getName").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveEncodingMethod                   ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    EncodingCopyMethodInfo                  ,
#endif
    encodingCopy                            ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    EncodingFreeMethodInfo                  ,
#endif
    encodingFree                            ,


-- ** getAll #method:getAll#

    encodingGetAll                          ,


-- ** getCharset #method:getCharset#

#if defined(ENABLE_OVERLOADING)
    EncodingGetCharsetMethodInfo            ,
#endif
    encodingGetCharset                      ,


-- ** getCurrent #method:getCurrent#

    encodingGetCurrent                      ,


-- ** getDefaultCandidates #method:getDefaultCandidates#

    encodingGetDefaultCandidates            ,


-- ** getFromCharset #method:getFromCharset#

    encodingGetFromCharset                  ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    EncodingGetNameMethodInfo               ,
#endif
    encodingGetName                         ,


-- ** getUtf8 #method:getUtf8#

    encodingGetUtf8                         ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    EncodingToStringMethodInfo              ,
#endif
    encodingToString                        ,




    ) where

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

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


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

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

foreign import ccall "gtk_source_encoding_get_type" c_gtk_source_encoding_get_type :: 
    IO GType

type instance O.ParentTypes Encoding = '[]
instance O.HasParentTypes Encoding

instance B.Types.TypedObject Encoding where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_encoding_get_type

instance B.Types.GBoxed Encoding

-- | Convert 'Encoding' 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 Encoding) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_source_encoding_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Encoding -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Encoding
P.Nothing = Ptr GValue -> Ptr Encoding -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Encoding
forall a. Ptr a
FP.nullPtr :: FP.Ptr Encoding)
    gvalueSet_ Ptr GValue
gv (P.Just Encoding
obj) = Encoding -> (Ptr Encoding -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Encoding
obj (Ptr GValue -> Ptr Encoding -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Encoding)
gvalueGet_ Ptr GValue
gv = do
        Ptr Encoding
ptr <- Ptr GValue -> IO (Ptr Encoding)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Encoding)
        if Ptr Encoding
ptr Ptr Encoding -> Ptr Encoding -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Encoding
forall a. Ptr a
FP.nullPtr
        then Encoding -> Maybe Encoding
forall a. a -> Maybe a
P.Just (Encoding -> Maybe Encoding) -> IO Encoding -> IO (Maybe Encoding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Encoding -> Encoding
Encoding Ptr Encoding
ptr
        else Maybe Encoding -> IO (Maybe Encoding)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Encoding
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Encoding
type instance O.AttributeList Encoding = EncodingAttributeList
type EncodingAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method Encoding::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Encoding" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceEncoding."
--                 , 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_encoding_copy" gtk_source_encoding_copy :: 
    Ptr Encoding ->                         -- enc : TInterface (Name {namespace = "GtkSource", name = "Encoding"})
    IO (Ptr Encoding)

-- | Used by language bindings.
-- 
-- /Since: 3.14/
encodingCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Encoding
    -- ^ /@enc@/: a t'GI.GtkSource.Structs.Encoding.Encoding'.
    -> m Encoding
    -- ^ __Returns:__ a copy of /@enc@/.
encodingCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Encoding -> m Encoding
encodingCopy Encoding
enc = IO Encoding -> m Encoding
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Encoding -> m Encoding) -> IO Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ do
    Ptr Encoding
enc' <- Encoding -> IO (Ptr Encoding)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Encoding
enc
    Ptr Encoding
result <- Ptr Encoding -> IO (Ptr Encoding)
gtk_source_encoding_copy Ptr Encoding
enc'
    Text -> Ptr Encoding -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingCopy" Ptr Encoding
result
    Encoding
result' <- ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Encoding -> Encoding
Encoding) Ptr Encoding
result
    Encoding -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Encoding
enc
    Encoding -> IO Encoding
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
result'

#if defined(ENABLE_OVERLOADING)
data EncodingCopyMethodInfo
instance (signature ~ (m Encoding), MonadIO m) => O.OverloadedMethod EncodingCopyMethodInfo Encoding signature where
    overloadedMethod = encodingCopy

instance O.OverloadedMethodInfo EncodingCopyMethodInfo Encoding where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Structs.Encoding.encodingCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.26/docs/GI-GtkSource-Structs-Encoding.html#v:encodingCopy"
        })


#endif

-- method Encoding::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Encoding" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceEncoding."
--                 , 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_encoding_free" gtk_source_encoding_free :: 
    Ptr Encoding ->                         -- enc : TInterface (Name {namespace = "GtkSource", name = "Encoding"})
    IO ()

-- | Used by language bindings.
-- 
-- /Since: 3.14/
encodingFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Encoding
    -- ^ /@enc@/: a t'GI.GtkSource.Structs.Encoding.Encoding'.
    -> m ()
encodingFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Encoding -> m ()
encodingFree Encoding
enc = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Encoding
enc' <- Encoding -> IO (Ptr Encoding)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Encoding
enc
    Ptr Encoding -> IO ()
gtk_source_encoding_free Ptr Encoding
enc'
    Encoding -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Encoding
enc
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod EncodingFreeMethodInfo Encoding signature where
    overloadedMethod = encodingFree

instance O.OverloadedMethodInfo EncodingFreeMethodInfo Encoding where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Structs.Encoding.encodingFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.26/docs/GI-GtkSource-Structs-Encoding.html#v:encodingFree"
        })


#endif

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

foreign import ccall "gtk_source_encoding_get_charset" gtk_source_encoding_get_charset :: 
    Ptr Encoding ->                         -- enc : TInterface (Name {namespace = "GtkSource", name = "Encoding"})
    IO CString

-- | Gets the character set of the t'GI.GtkSource.Structs.Encoding.Encoding', such as \"UTF-8\" or
-- \"ISO-8859-1\".
-- 
-- /Since: 3.14/
encodingGetCharset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Encoding
    -- ^ /@enc@/: a t'GI.GtkSource.Structs.Encoding.Encoding'.
    -> m T.Text
    -- ^ __Returns:__ the character set of the t'GI.GtkSource.Structs.Encoding.Encoding'.
encodingGetCharset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Encoding -> m Text
encodingGetCharset Encoding
enc = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Encoding
enc' <- Encoding -> IO (Ptr Encoding)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Encoding
enc
    CString
result <- Ptr Encoding -> IO CString
gtk_source_encoding_get_charset Ptr Encoding
enc'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingGetCharset" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Encoding -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Encoding
enc
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingGetCharsetMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod EncodingGetCharsetMethodInfo Encoding signature where
    overloadedMethod = encodingGetCharset

instance O.OverloadedMethodInfo EncodingGetCharsetMethodInfo Encoding where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Structs.Encoding.encodingGetCharset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.26/docs/GI-GtkSource-Structs-Encoding.html#v:encodingGetCharset"
        })


#endif

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

foreign import ccall "gtk_source_encoding_get_name" gtk_source_encoding_get_name :: 
    Ptr Encoding ->                         -- enc : TInterface (Name {namespace = "GtkSource", name = "Encoding"})
    IO CString

-- | Gets the name of the t'GI.GtkSource.Structs.Encoding.Encoding' such as \"Unicode\" or \"Western\".
-- 
-- /Since: 3.14/
encodingGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Encoding
    -- ^ /@enc@/: a t'GI.GtkSource.Structs.Encoding.Encoding'.
    -> m T.Text
    -- ^ __Returns:__ the name of the t'GI.GtkSource.Structs.Encoding.Encoding'.
encodingGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Encoding -> m Text
encodingGetName Encoding
enc = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Encoding
enc' <- Encoding -> IO (Ptr Encoding)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Encoding
enc
    CString
result <- Ptr Encoding -> IO CString
gtk_source_encoding_get_name Ptr Encoding
enc'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Encoding -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Encoding
enc
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod EncodingGetNameMethodInfo Encoding signature where
    overloadedMethod = encodingGetName

instance O.OverloadedMethodInfo EncodingGetNameMethodInfo Encoding where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Structs.Encoding.encodingGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.26/docs/GI-GtkSource-Structs-Encoding.html#v:encodingGetName"
        })


#endif

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

foreign import ccall "gtk_source_encoding_to_string" gtk_source_encoding_to_string :: 
    Ptr Encoding ->                         -- enc : TInterface (Name {namespace = "GtkSource", name = "Encoding"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
encodingToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Encoding
    -- ^ /@enc@/: a t'GI.GtkSource.Structs.Encoding.Encoding'.
    -> m T.Text
    -- ^ __Returns:__ a string representation. Free with 'GI.GLib.Functions.free' when no longer needed.
encodingToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Encoding -> m Text
encodingToString Encoding
enc = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Encoding
enc' <- Encoding -> IO (Ptr Encoding)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Encoding
enc
    CString
result <- Ptr Encoding -> IO CString
gtk_source_encoding_to_string Ptr Encoding
enc'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Encoding -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Encoding
enc
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod EncodingToStringMethodInfo Encoding signature where
    overloadedMethod = encodingToString

instance O.OverloadedMethodInfo EncodingToStringMethodInfo Encoding where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Structs.Encoding.encodingToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-3.0.26/docs/GI-GtkSource-Structs-Encoding.html#v:encodingToString"
        })


#endif

-- method Encoding::get_all
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "GtkSource" , name = "Encoding" }))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_encoding_get_all" gtk_source_encoding_get_all :: 
    IO (Ptr (GSList (Ptr Encoding)))

-- | Gets all encodings.
-- 
-- /Since: 3.14/
encodingGetAll ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [Encoding]
    -- ^ __Returns:__ a list of
    -- all t'GI.GtkSource.Structs.Encoding.Encoding'\'s. Free with @/g_slist_free()/@.
encodingGetAll :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m [Encoding]
encodingGetAll  = IO [Encoding] -> m [Encoding]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Encoding] -> m [Encoding]) -> IO [Encoding] -> m [Encoding]
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GSList (Ptr Encoding))
result <- IO (Ptr (GSList (Ptr Encoding)))
gtk_source_encoding_get_all
    [Ptr Encoding]
result' <- Ptr (GSList (Ptr Encoding)) -> IO [Ptr Encoding]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Encoding))
result
    [Encoding]
result'' <- (Ptr Encoding -> IO Encoding) -> [Ptr Encoding] -> IO [Encoding]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Encoding -> Encoding
Encoding) [Ptr Encoding]
result'
    Ptr (GSList (Ptr Encoding)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Encoding))
result
    [Encoding] -> IO [Encoding]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Encoding]
result''

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_source_encoding_get_current" gtk_source_encoding_get_current :: 
    IO (Ptr Encoding)

-- | Gets the t'GI.GtkSource.Structs.Encoding.Encoding' for the current locale. See also 'GI.GLib.Functions.getCharset'.
-- 
-- /Since: 3.14/
encodingGetCurrent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Encoding
    -- ^ __Returns:__ the current locale encoding.
encodingGetCurrent :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Encoding
encodingGetCurrent  = IO Encoding -> m Encoding
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Encoding -> m Encoding) -> IO Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ do
    Ptr Encoding
result <- IO (Ptr Encoding)
gtk_source_encoding_get_current
    Text -> Ptr Encoding -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingGetCurrent" 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
Encoding) Ptr Encoding
result
    Encoding -> IO Encoding
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Encoding::get_default_candidates
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "GtkSource" , name = "Encoding" }))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_encoding_get_default_candidates" gtk_source_encoding_get_default_candidates :: 
    IO (Ptr (GSList (Ptr Encoding)))

-- | Gets the list of default candidate encodings to try when loading a file. See
-- 'GI.GtkSource.Objects.FileLoader.fileLoaderSetCandidateEncodings'.
-- 
-- This function returns a different list depending on the current locale (i.e.
-- language, country and default encoding). The UTF-8 encoding and the current
-- locale encoding are guaranteed to be present in the returned list.
-- 
-- /Since: 3.18/
encodingGetDefaultCandidates ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [Encoding]
    -- ^ __Returns:__ the list of
    -- default candidate encodings. Free with @/g_slist_free()/@.
encodingGetDefaultCandidates :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m [Encoding]
encodingGetDefaultCandidates  = IO [Encoding] -> m [Encoding]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Encoding] -> m [Encoding]) -> IO [Encoding] -> m [Encoding]
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GSList (Ptr Encoding))
result <- IO (Ptr (GSList (Ptr Encoding)))
gtk_source_encoding_get_default_candidates
    [Ptr Encoding]
result' <- Ptr (GSList (Ptr Encoding)) -> IO [Ptr Encoding]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Encoding))
result
    [Encoding]
result'' <- (Ptr Encoding -> IO Encoding) -> [Ptr Encoding] -> IO [Encoding]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Encoding -> Encoding
Encoding) [Ptr Encoding]
result'
    Ptr (GSList (Ptr Encoding)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Encoding))
result
    [Encoding] -> IO [Encoding]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Encoding]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method Encoding::get_from_charset
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "charset"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a character set." , 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_encoding_get_from_charset" gtk_source_encoding_get_from_charset :: 
    CString ->                              -- charset : TBasicType TUTF8
    IO (Ptr Encoding)

-- | Gets a t'GI.GtkSource.Structs.Encoding.Encoding' from a character set such as \"UTF-8\" or
-- \"ISO-8859-1\".
-- 
-- /Since: 3.14/
encodingGetFromCharset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@charset@/: a character set.
    -> m (Maybe Encoding)
    -- ^ __Returns:__ the corresponding t'GI.GtkSource.Structs.Encoding.Encoding', or 'P.Nothing'
    -- if not found.
encodingGetFromCharset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Encoding)
encodingGetFromCharset Text
charset = IO (Maybe Encoding) -> m (Maybe Encoding)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Encoding) -> m (Maybe Encoding))
-> IO (Maybe Encoding) -> m (Maybe Encoding)
forall a b. (a -> b) -> a -> b
$ do
    CString
charset' <- Text -> IO CString
textToCString Text
charset
    Ptr Encoding
result <- CString -> IO (Ptr Encoding)
gtk_source_encoding_get_from_charset CString
charset'
    Maybe Encoding
maybeResult <- Ptr Encoding
-> (Ptr Encoding -> IO Encoding) -> IO (Maybe Encoding)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Encoding
result ((Ptr Encoding -> IO Encoding) -> IO (Maybe Encoding))
-> (Ptr Encoding -> IO Encoding) -> IO (Maybe Encoding)
forall a b. (a -> b) -> a -> b
$ \Ptr Encoding
result' -> do
        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
Encoding) Ptr Encoding
result'
        Encoding -> IO Encoding
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
charset'
    Maybe Encoding -> IO (Maybe Encoding)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Encoding
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_source_encoding_get_utf8" gtk_source_encoding_get_utf8 :: 
    IO (Ptr Encoding)

-- | /No description available in the introspection data./
-- 
-- /Since: 3.14/
encodingGetUtf8 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Encoding
    -- ^ __Returns:__ the UTF-8 encoding.
encodingGetUtf8 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Encoding
encodingGetUtf8  = IO Encoding -> m Encoding
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Encoding -> m Encoding) -> IO Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ do
    Ptr Encoding
result <- IO (Ptr Encoding)
gtk_source_encoding_get_utf8
    Text -> Ptr Encoding -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"encodingGetUtf8" 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
Encoding) Ptr Encoding
result
    Encoding -> IO Encoding
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveEncodingMethod (t :: Symbol) (o :: *) :: * where
    ResolveEncodingMethod "copy" o = EncodingCopyMethodInfo
    ResolveEncodingMethod "free" o = EncodingFreeMethodInfo
    ResolveEncodingMethod "toString" o = EncodingToStringMethodInfo
    ResolveEncodingMethod "getCharset" o = EncodingGetCharsetMethodInfo
    ResolveEncodingMethod "getName" o = EncodingGetNameMethodInfo
    ResolveEncodingMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif