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

-- * Exported types
    Encoding(..)                            ,
    noEncoding                              ,


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

#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.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


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

instance BoxedObject Encoding where
    boxedType :: Encoding -> IO GType
boxedType _ = IO GType
c_gtk_source_encoding_get_type

-- | Convert 'Encoding' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Encoding where
    toGValue :: Encoding -> IO GValue
toGValue o :: Encoding
o = do
        GType
gtype <- IO GType
c_gtk_source_encoding_get_type
        Encoding -> (Ptr Encoding -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Encoding
o (GType
-> (GValue -> Ptr Encoding -> IO ()) -> Ptr Encoding -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Encoding -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Encoding
fromGValue gv :: GValue
gv = do
        Ptr Encoding
ptr <- GValue -> IO (Ptr Encoding)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Encoding)
        (ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Encoding -> Encoding
Encoding Ptr Encoding
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `Encoding`.
noEncoding :: Maybe Encoding
noEncoding :: Maybe Encoding
noEncoding = Maybe Encoding
forall a. Maybe a
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 :: Encoding -> m Encoding
encodingCopy enc :: Encoding
enc = 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 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 "encodingCopy" Ptr Encoding
result
    Encoding
result' <- ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, BoxedObject 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 (m :: * -> *) a. Monad m => a -> m a
return Encoding
result'

#if defined(ENABLE_OVERLOADING)
data EncodingCopyMethodInfo
instance (signature ~ (m Encoding), MonadIO m) => O.MethodInfo EncodingCopyMethodInfo Encoding signature where
    overloadedMethod = 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 :: Encoding -> m ()
encodingFree enc :: Encoding
enc = 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 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EncodingFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo EncodingFreeMethodInfo Encoding signature where
    overloadedMethod = 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 :: Encoding -> m Text
encodingGetCharset enc :: Encoding
enc = IO Text -> m Text
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 "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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingGetCharsetMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo EncodingGetCharsetMethodInfo Encoding signature where
    overloadedMethod = 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 :: Encoding -> m Text
encodingGetName enc :: Encoding
enc = IO Text -> m Text
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 "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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo EncodingGetNameMethodInfo Encoding signature where
    overloadedMethod = 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 :: Encoding -> m Text
encodingToString enc :: Encoding
enc = IO Text -> m Text
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 "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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EncodingToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo EncodingToStringMethodInfo Encoding signature where
    overloadedMethod = 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 :: m [Encoding]
encodingGetAll  = 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 (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)
mapM ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, BoxedObject 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 (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 :: m Encoding
encodingGetCurrent  = 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 Encoding
result <- IO (Ptr Encoding)
gtk_source_encoding_get_current
    Text -> Ptr Encoding -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "encodingGetCurrent" 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
Encoding) Ptr Encoding
result
    Encoding -> IO Encoding
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 :: m [Encoding]
encodingGetDefaultCandidates  = 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 (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)
mapM ((ManagedPtr Encoding -> Encoding) -> Ptr Encoding -> IO Encoding
forall a.
(HasCallStack, BoxedObject 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 (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 :: Text -> m (Maybe Encoding)
encodingGetFromCharset charset :: Text
charset = IO (Maybe Encoding) -> m (Maybe Encoding)
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
$ \result' :: Ptr Encoding
result' -> do
        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
Encoding) Ptr Encoding
result'
        Encoding -> IO Encoding
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 (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 :: m Encoding
encodingGetUtf8  = 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 Encoding
result <- IO (Ptr Encoding)
gtk_source_encoding_get_utf8
    Text -> Ptr Encoding -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "encodingGetUtf8" 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
Encoding) Ptr Encoding
result
    Encoding -> IO Encoding
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.MethodInfo 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

#endif