{-# 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.IBus.Objects.UnicodeBlock
    ( 

-- * Exported types
    UnicodeBlock(..)                        ,
    IsUnicodeBlock                          ,
    toUnicodeBlock                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveUnicodeBlockMethod               ,
#endif


-- ** getEnd #method:getEnd#

#if defined(ENABLE_OVERLOADING)
    UnicodeBlockGetEndMethodInfo            ,
#endif
    unicodeBlockGetEnd                      ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    UnicodeBlockGetNameMethodInfo           ,
#endif
    unicodeBlockGetName                     ,


-- ** getStart #method:getStart#

#if defined(ENABLE_OVERLOADING)
    UnicodeBlockGetStartMethodInfo          ,
#endif
    unicodeBlockGetStart                    ,


-- ** load #method:load#

    unicodeBlockLoad                        ,


-- ** save #method:save#

    unicodeBlockSave                        ,




 -- * Properties
-- ** end #attr:end#
-- | The Uniode end code point

#if defined(ENABLE_OVERLOADING)
    UnicodeBlockEndPropertyInfo             ,
#endif
    constructUnicodeBlockEnd                ,
    getUnicodeBlockEnd                      ,
#if defined(ENABLE_OVERLOADING)
    unicodeBlockEnd                         ,
#endif


-- ** name #attr:name#
-- | The Uniode block name

#if defined(ENABLE_OVERLOADING)
    UnicodeBlockNamePropertyInfo            ,
#endif
    clearUnicodeBlockName                   ,
    constructUnicodeBlockName               ,
    getUnicodeBlockName                     ,
    setUnicodeBlockName                     ,
#if defined(ENABLE_OVERLOADING)
    unicodeBlockName                        ,
#endif


-- ** start #attr:start#
-- | The Uniode start code point

#if defined(ENABLE_OVERLOADING)
    UnicodeBlockStartPropertyInfo           ,
#endif
    constructUnicodeBlockStart              ,
    getUnicodeBlockStart                    ,
#if defined(ENABLE_OVERLOADING)
    unicodeBlockStart                       ,
#endif




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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

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

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

foreign import ccall "ibus_unicode_block_get_type"
    c_ibus_unicode_block_get_type :: IO B.Types.GType

instance B.Types.TypedObject UnicodeBlock where
    glibType :: IO GType
glibType = IO GType
c_ibus_unicode_block_get_type

instance B.Types.GObject UnicodeBlock

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

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

instance O.HasParentTypes UnicodeBlock
type instance O.ParentTypes UnicodeBlock = '[IBus.Serializable.Serializable, IBus.Object.Object, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveUnicodeBlockMethod (t :: Symbol) (o :: *) :: * where
    ResolveUnicodeBlockMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveUnicodeBlockMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveUnicodeBlockMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveUnicodeBlockMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveUnicodeBlockMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveUnicodeBlockMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveUnicodeBlockMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveUnicodeBlockMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveUnicodeBlockMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveUnicodeBlockMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveUnicodeBlockMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveUnicodeBlockMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveUnicodeBlockMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveUnicodeBlockMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveUnicodeBlockMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveUnicodeBlockMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveUnicodeBlockMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveUnicodeBlockMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveUnicodeBlockMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveUnicodeBlockMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveUnicodeBlockMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveUnicodeBlockMethod "getEnd" o = UnicodeBlockGetEndMethodInfo
    ResolveUnicodeBlockMethod "getName" o = UnicodeBlockGetNameMethodInfo
    ResolveUnicodeBlockMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveUnicodeBlockMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveUnicodeBlockMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveUnicodeBlockMethod "getStart" o = UnicodeBlockGetStartMethodInfo
    ResolveUnicodeBlockMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveUnicodeBlockMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveUnicodeBlockMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveUnicodeBlockMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveUnicodeBlockMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "end"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@end@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUnicodeBlockEnd :: (IsUnicodeBlock o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructUnicodeBlockEnd :: Word32 -> m (GValueConstruct o)
constructUnicodeBlockEnd Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"end" Word32
val

#if defined(ENABLE_OVERLOADING)
data UnicodeBlockEndPropertyInfo
instance AttrInfo UnicodeBlockEndPropertyInfo where
    type AttrAllowedOps UnicodeBlockEndPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint UnicodeBlockEndPropertyInfo = IsUnicodeBlock
    type AttrSetTypeConstraint UnicodeBlockEndPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint UnicodeBlockEndPropertyInfo = (~) Word32
    type AttrTransferType UnicodeBlockEndPropertyInfo = Word32
    type AttrGetType UnicodeBlockEndPropertyInfo = Word32
    type AttrLabel UnicodeBlockEndPropertyInfo = "end"
    type AttrOrigin UnicodeBlockEndPropertyInfo = UnicodeBlock
    attrGet = getUnicodeBlockEnd
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructUnicodeBlockEnd
    attrClear = undefined
#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' unicodeBlock #name
-- @
getUnicodeBlockName :: (MonadIO m, IsUnicodeBlock o) => o -> m T.Text
getUnicodeBlockName :: o -> m Text
getUnicodeBlockName o
obj = 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
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getUnicodeBlockName" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name"

-- | Set the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' unicodeBlock [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setUnicodeBlockName :: (MonadIO m, IsUnicodeBlock o) => o -> T.Text -> m ()
setUnicodeBlockName :: o -> Text -> m ()
setUnicodeBlockName o
obj Text
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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUnicodeBlockName :: (IsUnicodeBlock o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructUnicodeBlockName :: Text -> m (GValueConstruct o)
constructUnicodeBlockName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@name@” 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' #name
-- @
clearUnicodeBlockName :: (MonadIO m, IsUnicodeBlock o) => o -> m ()
clearUnicodeBlockName :: o -> m ()
clearUnicodeBlockName 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data UnicodeBlockNamePropertyInfo
instance AttrInfo UnicodeBlockNamePropertyInfo where
    type AttrAllowedOps UnicodeBlockNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint UnicodeBlockNamePropertyInfo = IsUnicodeBlock
    type AttrSetTypeConstraint UnicodeBlockNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint UnicodeBlockNamePropertyInfo = (~) T.Text
    type AttrTransferType UnicodeBlockNamePropertyInfo = T.Text
    type AttrGetType UnicodeBlockNamePropertyInfo = T.Text
    type AttrLabel UnicodeBlockNamePropertyInfo = "name"
    type AttrOrigin UnicodeBlockNamePropertyInfo = UnicodeBlock
    attrGet = getUnicodeBlockName
    attrSet = setUnicodeBlockName
    attrTransfer _ v = do
        return v
    attrConstruct = constructUnicodeBlockName
    attrClear = clearUnicodeBlockName
#endif

-- VVV Prop "start"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@start@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUnicodeBlockStart :: (IsUnicodeBlock o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructUnicodeBlockStart :: Word32 -> m (GValueConstruct o)
constructUnicodeBlockStart Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"start" Word32
val

#if defined(ENABLE_OVERLOADING)
data UnicodeBlockStartPropertyInfo
instance AttrInfo UnicodeBlockStartPropertyInfo where
    type AttrAllowedOps UnicodeBlockStartPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint UnicodeBlockStartPropertyInfo = IsUnicodeBlock
    type AttrSetTypeConstraint UnicodeBlockStartPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint UnicodeBlockStartPropertyInfo = (~) Word32
    type AttrTransferType UnicodeBlockStartPropertyInfo = Word32
    type AttrGetType UnicodeBlockStartPropertyInfo = Word32
    type AttrLabel UnicodeBlockStartPropertyInfo = "start"
    type AttrOrigin UnicodeBlockStartPropertyInfo = UnicodeBlock
    attrGet = getUnicodeBlockStart
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructUnicodeBlockStart
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList UnicodeBlock
type instance O.AttributeList UnicodeBlock = UnicodeBlockAttributeList
type UnicodeBlockAttributeList = ('[ '("end", UnicodeBlockEndPropertyInfo), '("name", UnicodeBlockNamePropertyInfo), '("start", UnicodeBlockStartPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
unicodeBlockEnd :: AttrLabelProxy "end"
unicodeBlockEnd = AttrLabelProxy

unicodeBlockName :: AttrLabelProxy "name"
unicodeBlockName = AttrLabelProxy

unicodeBlockStart :: AttrLabelProxy "start"
unicodeBlockStart = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList UnicodeBlock = UnicodeBlockSignalList
type UnicodeBlockSignalList = ('[ '("destroy", IBus.Object.ObjectDestroySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method UnicodeBlock::get_end
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "block"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "UnicodeBlock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusUnicodeData"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUniChar)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_unicode_block_get_end" ibus_unicode_block_get_end :: 
    Ptr UnicodeBlock ->                     -- block : TInterface (Name {namespace = "IBus", name = "UnicodeBlock"})
    IO CInt

-- | Gets the end code point in t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock'.
unicodeBlockGetEnd ::
    (B.CallStack.HasCallStack, MonadIO m, IsUnicodeBlock a) =>
    a
    -- ^ /@block@/: An t'GI.IBus.Objects.UnicodeData.UnicodeData'
    -> m Char
    -- ^ __Returns:__ end property in t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock'
unicodeBlockGetEnd :: a -> m Char
unicodeBlockGetEnd a
block = IO Char -> m Char
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Char -> m Char) -> IO Char -> m Char
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnicodeBlock
block' <- a -> IO (Ptr UnicodeBlock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
block
    CInt
result <- Ptr UnicodeBlock -> IO CInt
ibus_unicode_block_get_end Ptr UnicodeBlock
block'
    let result' :: Char
result' = (Int -> Char
chr (Int -> Char) -> (CInt -> Int) -> CInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
block
    Char -> IO Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
result'

#if defined(ENABLE_OVERLOADING)
data UnicodeBlockGetEndMethodInfo
instance (signature ~ (m Char), MonadIO m, IsUnicodeBlock a) => O.MethodInfo UnicodeBlockGetEndMethodInfo a signature where
    overloadedMethod = unicodeBlockGetEnd

#endif

-- method UnicodeBlock::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "block"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "UnicodeBlock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusUnicodeBlock"
--                 , 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 "ibus_unicode_block_get_name" ibus_unicode_block_get_name :: 
    Ptr UnicodeBlock ->                     -- block : TInterface (Name {namespace = "IBus", name = "UnicodeBlock"})
    IO CString

-- | Gets the name in t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock'. It should not be freed.
unicodeBlockGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsUnicodeBlock a) =>
    a
    -- ^ /@block@/: An t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock'
    -> m T.Text
    -- ^ __Returns:__ name property in t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock'
unicodeBlockGetName :: a -> m Text
unicodeBlockGetName a
block = 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 UnicodeBlock
block' <- a -> IO (Ptr UnicodeBlock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
block
    CString
result <- Ptr UnicodeBlock -> IO CString
ibus_unicode_block_get_name Ptr UnicodeBlock
block'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unicodeBlockGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
block
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data UnicodeBlockGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsUnicodeBlock a) => O.MethodInfo UnicodeBlockGetNameMethodInfo a signature where
    overloadedMethod = unicodeBlockGetName

#endif

-- method UnicodeBlock::get_start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "block"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "UnicodeBlock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusUnicodeData"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUniChar)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_unicode_block_get_start" ibus_unicode_block_get_start :: 
    Ptr UnicodeBlock ->                     -- block : TInterface (Name {namespace = "IBus", name = "UnicodeBlock"})
    IO CInt

-- | Gets the start code point in t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock'.
unicodeBlockGetStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsUnicodeBlock a) =>
    a
    -- ^ /@block@/: An t'GI.IBus.Objects.UnicodeData.UnicodeData'
    -> m Char
    -- ^ __Returns:__ start property in t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock'
unicodeBlockGetStart :: a -> m Char
unicodeBlockGetStart a
block = IO Char -> m Char
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Char -> m Char) -> IO Char -> m Char
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnicodeBlock
block' <- a -> IO (Ptr UnicodeBlock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
block
    CInt
result <- Ptr UnicodeBlock -> IO CInt
ibus_unicode_block_get_start Ptr UnicodeBlock
block'
    let result' :: Char
result' = (Int -> Char
chr (Int -> Char) -> (CInt -> Int) -> CInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
block
    Char -> IO Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
result'

#if defined(ENABLE_OVERLOADING)
data UnicodeBlockGetStartMethodInfo
instance (signature ~ (m Char), MonadIO m, IsUnicodeBlock a) => O.MethodInfo UnicodeBlockGetStartMethodInfo a signature where
    overloadedMethod = unicodeBlockGetStart

#endif

-- method UnicodeBlock::load
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A path of the saved dictionary file."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "IBus" , name = "UnicodeBlock" }))
-- throws : False
-- Skip return : False

foreign import ccall "ibus_unicode_block_load" ibus_unicode_block_load :: 
    CString ->                              -- path : TBasicType TUTF8
    IO (Ptr (GSList (Ptr UnicodeBlock)))

-- | /No description available in the introspection data./
unicodeBlockLoad ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@path@/: A path of the saved dictionary file.
    -> m [UnicodeBlock]
    -- ^ __Returns:__ 
    -- An t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock' list loaded from the saved cache file.
unicodeBlockLoad :: Text -> m [UnicodeBlock]
unicodeBlockLoad Text
path = IO [UnicodeBlock] -> m [UnicodeBlock]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [UnicodeBlock] -> m [UnicodeBlock])
-> IO [UnicodeBlock] -> m [UnicodeBlock]
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr (GSList (Ptr UnicodeBlock))
result <- CString -> IO (Ptr (GSList (Ptr UnicodeBlock)))
ibus_unicode_block_load CString
path'
    [Ptr UnicodeBlock]
result' <- Ptr (GSList (Ptr UnicodeBlock)) -> IO [Ptr UnicodeBlock]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr UnicodeBlock))
result
    [UnicodeBlock]
result'' <- (Ptr UnicodeBlock -> IO UnicodeBlock)
-> [Ptr UnicodeBlock] -> IO [UnicodeBlock]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr UnicodeBlock -> UnicodeBlock)
-> Ptr UnicodeBlock -> IO UnicodeBlock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr UnicodeBlock -> UnicodeBlock
UnicodeBlock) [Ptr UnicodeBlock]
result'
    Ptr (GSList (Ptr UnicodeBlock)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr UnicodeBlock))
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    [UnicodeBlock] -> IO [UnicodeBlock]
forall (m :: * -> *) a. Monad m => a -> m a
return [UnicodeBlock]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method UnicodeBlock::save
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A path of the saved Unicode block."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "IBus" , name = "UnicodeBlock" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A list of unicode\n block."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_unicode_block_save" ibus_unicode_block_save :: 
    CString ->                              -- path : TBasicType TUTF8
    Ptr (GSList (Ptr UnicodeBlock)) ->      -- list : TGSList (TInterface (Name {namespace = "IBus", name = "UnicodeBlock"}))
    IO ()

-- | Save the list of t'GI.IBus.Objects.UnicodeBlock.UnicodeBlock' to the cache file.
unicodeBlockSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsUnicodeBlock a) =>
    T.Text
    -- ^ /@path@/: A path of the saved Unicode block.
    -> [a]
    -- ^ /@list@/: A list of unicode
    --  block.
    -> m ()
unicodeBlockSave :: Text -> [a] -> m ()
unicodeBlockSave Text
path [a]
list = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    [Ptr UnicodeBlock]
list' <- (a -> IO (Ptr UnicodeBlock)) -> [a] -> IO [Ptr UnicodeBlock]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> IO (Ptr UnicodeBlock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr UnicodeBlock))
list'' <- [Ptr UnicodeBlock] -> IO (Ptr (GSList (Ptr UnicodeBlock)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr UnicodeBlock]
list'
    CString -> Ptr (GSList (Ptr UnicodeBlock)) -> IO ()
ibus_unicode_block_save CString
path' Ptr (GSList (Ptr UnicodeBlock))
list''
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    Ptr (GSList (Ptr UnicodeBlock)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr UnicodeBlock))
list''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif