{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Range of text in an preedit string to be shown underlined.
-- 
-- /Since: 2.28/

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

module GI.WebKit.Structs.InputMethodUnderline
    ( 

-- * Exported types
    InputMethodUnderline(..)                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveInputMethodUnderlineMethod       ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    InputMethodUnderlineCopyMethodInfo      ,
#endif
    inputMethodUnderlineCopy                ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    InputMethodUnderlineFreeMethodInfo      ,
#endif
    inputMethodUnderlineFree                ,


-- ** new #method:new#

    inputMethodUnderlineNew                 ,


-- ** setColor #method:setColor#

#if defined(ENABLE_OVERLOADING)
    InputMethodUnderlineSetColorMethodInfo  ,
#endif
    inputMethodUnderlineSetColor            ,




    ) 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.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA

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

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

foreign import ccall "webkit_input_method_underline_get_type" c_webkit_input_method_underline_get_type :: 
    IO GType

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

instance B.Types.TypedObject InputMethodUnderline where
    glibType :: IO GType
glibType = IO GType
c_webkit_input_method_underline_get_type

instance B.Types.GBoxed InputMethodUnderline

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList InputMethodUnderline
type instance O.AttributeList InputMethodUnderline = InputMethodUnderlineAttributeList
type InputMethodUnderlineAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method InputMethodUnderline::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "start_offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start offset in preedit string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end_offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end offset in preedit string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit" , name = "InputMethodUnderline" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_underline_new" webkit_input_method_underline_new :: 
    Word32 ->                               -- start_offset : TBasicType TUInt
    Word32 ->                               -- end_offset : TBasicType TUInt
    IO (Ptr InputMethodUnderline)

-- | Create a new t'GI.WebKit.Structs.InputMethodUnderline.InputMethodUnderline' for the given range in preedit string
-- 
-- /Since: 2.28/
inputMethodUnderlineNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@startOffset@/: the start offset in preedit string
    -> Word32
    -- ^ /@endOffset@/: the end offset in preedit string
    -> m InputMethodUnderline
    -- ^ __Returns:__ A newly created t'GI.WebKit.Structs.InputMethodUnderline.InputMethodUnderline'
inputMethodUnderlineNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> Word32 -> m InputMethodUnderline
inputMethodUnderlineNew Word32
startOffset Word32
endOffset = IO InputMethodUnderline -> m InputMethodUnderline
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputMethodUnderline -> m InputMethodUnderline)
-> IO InputMethodUnderline -> m InputMethodUnderline
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputMethodUnderline
result <- Word32 -> Word32 -> IO (Ptr InputMethodUnderline)
webkit_input_method_underline_new Word32
startOffset Word32
endOffset
    Text -> Ptr InputMethodUnderline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputMethodUnderlineNew" Ptr InputMethodUnderline
result
    InputMethodUnderline
result' <- ((ManagedPtr InputMethodUnderline -> InputMethodUnderline)
-> Ptr InputMethodUnderline -> IO InputMethodUnderline
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr InputMethodUnderline -> InputMethodUnderline
InputMethodUnderline) Ptr InputMethodUnderline
result
    InputMethodUnderline -> IO InputMethodUnderline
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputMethodUnderline
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method InputMethodUnderline::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "underline"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit" , name = "InputMethodUnderline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitInputMethodUnderline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit" , name = "InputMethodUnderline" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_underline_copy" webkit_input_method_underline_copy :: 
    Ptr InputMethodUnderline ->             -- underline : TInterface (Name {namespace = "WebKit", name = "InputMethodUnderline"})
    IO (Ptr InputMethodUnderline)

-- | Make a copy of the t'GI.WebKit.Structs.InputMethodUnderline.InputMethodUnderline'.
-- 
-- /Since: 2.28/
inputMethodUnderlineCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    InputMethodUnderline
    -- ^ /@underline@/: a t'GI.WebKit.Structs.InputMethodUnderline.InputMethodUnderline'
    -> m InputMethodUnderline
    -- ^ __Returns:__ A copy of passed in t'GI.WebKit.Structs.InputMethodUnderline.InputMethodUnderline'
inputMethodUnderlineCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
InputMethodUnderline -> m InputMethodUnderline
inputMethodUnderlineCopy InputMethodUnderline
underline = IO InputMethodUnderline -> m InputMethodUnderline
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputMethodUnderline -> m InputMethodUnderline)
-> IO InputMethodUnderline -> m InputMethodUnderline
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputMethodUnderline
underline' <- InputMethodUnderline -> IO (Ptr InputMethodUnderline)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr InputMethodUnderline
underline
    Ptr InputMethodUnderline
result <- Ptr InputMethodUnderline -> IO (Ptr InputMethodUnderline)
webkit_input_method_underline_copy Ptr InputMethodUnderline
underline'
    Text -> Ptr InputMethodUnderline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputMethodUnderlineCopy" Ptr InputMethodUnderline
result
    InputMethodUnderline
result' <- ((ManagedPtr InputMethodUnderline -> InputMethodUnderline)
-> Ptr InputMethodUnderline -> IO InputMethodUnderline
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr InputMethodUnderline -> InputMethodUnderline
InputMethodUnderline) Ptr InputMethodUnderline
result
    InputMethodUnderline -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr InputMethodUnderline
underline
    InputMethodUnderline -> IO InputMethodUnderline
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputMethodUnderline
result'

#if defined(ENABLE_OVERLOADING)
data InputMethodUnderlineCopyMethodInfo
instance (signature ~ (m InputMethodUnderline), MonadIO m) => O.OverloadedMethod InputMethodUnderlineCopyMethodInfo InputMethodUnderline signature where
    overloadedMethod = inputMethodUnderlineCopy

instance O.OverloadedMethodInfo InputMethodUnderlineCopyMethodInfo InputMethodUnderline where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Structs.InputMethodUnderline.inputMethodUnderlineCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Structs-InputMethodUnderline.html#v:inputMethodUnderlineCopy"
        })


#endif

-- method InputMethodUnderline::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "underline"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit" , name = "InputMethodUnderline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitInputMethodUnderline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_underline_free" webkit_input_method_underline_free :: 
    Ptr InputMethodUnderline ->             -- underline : TInterface (Name {namespace = "WebKit", name = "InputMethodUnderline"})
    IO ()

-- | Free the t'GI.WebKit.Structs.InputMethodUnderline.InputMethodUnderline'.
-- 
-- /Since: 2.28/
inputMethodUnderlineFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    InputMethodUnderline
    -- ^ /@underline@/: A t'GI.WebKit.Structs.InputMethodUnderline.InputMethodUnderline'
    -> m ()
inputMethodUnderlineFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
InputMethodUnderline -> m ()
inputMethodUnderlineFree InputMethodUnderline
underline = 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 InputMethodUnderline
underline' <- InputMethodUnderline -> IO (Ptr InputMethodUnderline)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr InputMethodUnderline
underline
    Ptr InputMethodUnderline -> IO ()
webkit_input_method_underline_free Ptr InputMethodUnderline
underline'
    InputMethodUnderline -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr InputMethodUnderline
underline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodUnderlineFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod InputMethodUnderlineFreeMethodInfo InputMethodUnderline signature where
    overloadedMethod = inputMethodUnderlineFree

instance O.OverloadedMethodInfo InputMethodUnderlineFreeMethodInfo InputMethodUnderline where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Structs.InputMethodUnderline.inputMethodUnderlineFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Structs-InputMethodUnderline.html#v:inputMethodUnderlineFree"
        })


#endif

-- method InputMethodUnderline::set_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "underline"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit" , name = "InputMethodUnderline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitInputMethodUnderline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rgba"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkRGBA or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_underline_set_color" webkit_input_method_underline_set_color :: 
    Ptr InputMethodUnderline ->             -- underline : TInterface (Name {namespace = "WebKit", name = "InputMethodUnderline"})
    Ptr Gdk.RGBA.RGBA ->                    -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO ()

-- | Set the color of the underline.
-- 
-- If /@rgba@/ is 'P.Nothing' the foreground text color will be used
-- for the underline too.
-- 
-- /Since: 2.28/
inputMethodUnderlineSetColor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    InputMethodUnderline
    -- ^ /@underline@/: a t'GI.WebKit.Structs.InputMethodUnderline.InputMethodUnderline'
    -> Maybe (Gdk.RGBA.RGBA)
    -- ^ /@rgba@/: a t'GI.Gdk.Structs.RGBA.RGBA' or 'P.Nothing'
    -> m ()
inputMethodUnderlineSetColor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
InputMethodUnderline -> Maybe RGBA -> m ()
inputMethodUnderlineSetColor InputMethodUnderline
underline Maybe RGBA
rgba = 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 InputMethodUnderline
underline' <- InputMethodUnderline -> IO (Ptr InputMethodUnderline)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr InputMethodUnderline
underline
    Ptr RGBA
maybeRgba <- case Maybe RGBA
rgba of
        Maybe RGBA
Nothing -> Ptr RGBA -> IO (Ptr RGBA)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
forall a. Ptr a
nullPtr
        Just RGBA
jRgba -> do
            Ptr RGBA
jRgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
jRgba
            Ptr RGBA -> IO (Ptr RGBA)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RGBA
jRgba'
    Ptr InputMethodUnderline -> Ptr RGBA -> IO ()
webkit_input_method_underline_set_color Ptr InputMethodUnderline
underline' Ptr RGBA
maybeRgba
    InputMethodUnderline -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr InputMethodUnderline
underline
    Maybe RGBA -> (RGBA -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RGBA
rgba RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodUnderlineSetColorMethodInfo
instance (signature ~ (Maybe (Gdk.RGBA.RGBA) -> m ()), MonadIO m) => O.OverloadedMethod InputMethodUnderlineSetColorMethodInfo InputMethodUnderline signature where
    overloadedMethod = inputMethodUnderlineSetColor

instance O.OverloadedMethodInfo InputMethodUnderlineSetColorMethodInfo InputMethodUnderline where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Structs.InputMethodUnderline.inputMethodUnderlineSetColor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Structs-InputMethodUnderline.html#v:inputMethodUnderlineSetColor"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveInputMethodUnderlineMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveInputMethodUnderlineMethod "copy" o = InputMethodUnderlineCopyMethodInfo
    ResolveInputMethodUnderlineMethod "free" o = InputMethodUnderlineFreeMethodInfo
    ResolveInputMethodUnderlineMethod "setColor" o = InputMethodUnderlineSetColorMethodInfo
    ResolveInputMethodUnderlineMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif