{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Pango.Structs.Color.Color' structure is used to
-- represent a color in an uncalibrated RGB color-space.

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

module GI.Pango.Structs.Color
    ( 

-- * Exported types
    Color(..)                               ,
    newZeroColor                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveColorMethod                      ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    ColorCopyMethodInfo                     ,
#endif
    colorCopy                               ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    ColorFreeMethodInfo                     ,
#endif
    colorFree                               ,


-- ** parse #method:parse#

#if defined(ENABLE_OVERLOADING)
    ColorParseMethodInfo                    ,
#endif
    colorParse                              ,


-- ** parseWithAlpha #method:parseWithAlpha#

#if defined(ENABLE_OVERLOADING)
    ColorParseWithAlphaMethodInfo           ,
#endif
    colorParseWithAlpha                     ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    ColorToStringMethodInfo                 ,
#endif
    colorToString                           ,




 -- * Properties


-- ** blue #attr:blue#
-- | value of blue component

#if defined(ENABLE_OVERLOADING)
    color_blue                              ,
#endif
    getColorBlue                            ,
    setColorBlue                            ,


-- ** green #attr:green#
-- | value of green component

#if defined(ENABLE_OVERLOADING)
    color_green                             ,
#endif
    getColorGreen                           ,
    setColorGreen                           ,


-- ** red #attr:red#
-- | value of red component

#if defined(ENABLE_OVERLOADING)
    color_red                               ,
#endif
    getColorRed                             ,
    setColorRed                             ,




    ) 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.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 GHC.Records as R


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

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

foreign import ccall "pango_color_get_type" c_pango_color_get_type :: 
    IO GType

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

instance B.Types.TypedObject Color where
    glibType :: IO GType
glibType = IO GType
c_pango_color_get_type

instance B.Types.GBoxed Color

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

-- | Construct a `Color` struct initialized to zero.
newZeroColor :: MonadIO m => m Color
newZeroColor :: forall (m :: * -> *). MonadIO m => m Color
newZeroColor = IO Color -> m Color
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
6 IO (Ptr Color) -> (Ptr Color -> IO Color) -> IO Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color

instance tag ~ 'AttrSet => Constructible Color tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Color -> Color) -> [AttrOp Color tag] -> m Color
new ManagedPtr Color -> Color
_ [AttrOp Color tag]
attrs = do
        Color
o <- m Color
forall (m :: * -> *). MonadIO m => m Color
newZeroColor
        Color -> [AttrOp Color 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Color
o [AttrOp Color tag]
[AttrOp Color 'AttrSet]
attrs
        Color -> m Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
o


-- | Get the value of the “@red@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' color #red
-- @
getColorRed :: MonadIO m => Color -> m Word16
getColorRed :: forall (m :: * -> *). MonadIO m => Color -> m Word16
getColorRed Color
s = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO Word16) -> IO Word16
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO Word16) -> IO Word16)
-> (Ptr Color -> IO Word16) -> IO Word16
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Word16
val <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Color
ptr Ptr Color -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Word16
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
val

-- | Set the value of the “@red@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' color [ #red 'Data.GI.Base.Attributes.:=' value ]
-- @
setColorRed :: MonadIO m => Color -> Word16 -> m ()
setColorRed :: forall (m :: * -> *). MonadIO m => Color -> Word16 -> m ()
setColorRed Color
s Word16
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Color
ptr Ptr Color -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Word16
val :: Word16)

#if defined(ENABLE_OVERLOADING)
data ColorRedFieldInfo
instance AttrInfo ColorRedFieldInfo where
    type AttrBaseTypeConstraint ColorRedFieldInfo = (~) Color
    type AttrAllowedOps ColorRedFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ColorRedFieldInfo = (~) Word16
    type AttrTransferTypeConstraint ColorRedFieldInfo = (~)Word16
    type AttrTransferType ColorRedFieldInfo = Word16
    type AttrGetType ColorRedFieldInfo = Word16
    type AttrLabel ColorRedFieldInfo = "red"
    type AttrOrigin ColorRedFieldInfo = Color
    attrGet = getColorRed
    attrSet = setColorRed
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

color_red :: AttrLabelProxy "red"
color_red = AttrLabelProxy

#endif


-- | Get the value of the “@green@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' color #green
-- @
getColorGreen :: MonadIO m => Color -> m Word16
getColorGreen :: forall (m :: * -> *). MonadIO m => Color -> m Word16
getColorGreen Color
s = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO Word16) -> IO Word16
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO Word16) -> IO Word16)
-> (Ptr Color -> IO Word16) -> IO Word16
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Word16
val <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Color
ptr Ptr Color -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) :: IO Word16
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
val

-- | Set the value of the “@green@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' color [ #green 'Data.GI.Base.Attributes.:=' value ]
-- @
setColorGreen :: MonadIO m => Color -> Word16 -> m ()
setColorGreen :: forall (m :: * -> *). MonadIO m => Color -> Word16 -> m ()
setColorGreen Color
s Word16
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Color
ptr Ptr Color -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word16
val :: Word16)

#if defined(ENABLE_OVERLOADING)
data ColorGreenFieldInfo
instance AttrInfo ColorGreenFieldInfo where
    type AttrBaseTypeConstraint ColorGreenFieldInfo = (~) Color
    type AttrAllowedOps ColorGreenFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ColorGreenFieldInfo = (~) Word16
    type AttrTransferTypeConstraint ColorGreenFieldInfo = (~)Word16
    type AttrTransferType ColorGreenFieldInfo = Word16
    type AttrGetType ColorGreenFieldInfo = Word16
    type AttrLabel ColorGreenFieldInfo = "green"
    type AttrOrigin ColorGreenFieldInfo = Color
    attrGet = getColorGreen
    attrSet = setColorGreen
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

color_green :: AttrLabelProxy "green"
color_green = AttrLabelProxy

#endif


-- | Get the value of the “@blue@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' color #blue
-- @
getColorBlue :: MonadIO m => Color -> m Word16
getColorBlue :: forall (m :: * -> *). MonadIO m => Color -> m Word16
getColorBlue Color
s = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO Word16) -> IO Word16
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO Word16) -> IO Word16)
-> (Ptr Color -> IO Word16) -> IO Word16
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Word16
val <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Color
ptr Ptr Color -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) :: IO Word16
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
val

-- | Set the value of the “@blue@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' color [ #blue 'Data.GI.Base.Attributes.:=' value ]
-- @
setColorBlue :: MonadIO m => Color -> Word16 -> m ()
setColorBlue :: forall (m :: * -> *). MonadIO m => Color -> Word16 -> m ()
setColorBlue Color
s Word16
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Color -> (Ptr Color -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Color
s ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Color
ptr -> do
    Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Color
ptr Ptr Color -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Word16
val :: Word16)

#if defined(ENABLE_OVERLOADING)
data ColorBlueFieldInfo
instance AttrInfo ColorBlueFieldInfo where
    type AttrBaseTypeConstraint ColorBlueFieldInfo = (~) Color
    type AttrAllowedOps ColorBlueFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ColorBlueFieldInfo = (~) Word16
    type AttrTransferTypeConstraint ColorBlueFieldInfo = (~)Word16
    type AttrTransferType ColorBlueFieldInfo = Word16
    type AttrGetType ColorBlueFieldInfo = Word16
    type AttrLabel ColorBlueFieldInfo = "blue"
    type AttrOrigin ColorBlueFieldInfo = Color
    attrGet = getColorBlue
    attrSet = setColorBlue
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

color_blue :: AttrLabelProxy "blue"
color_blue = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Color
type instance O.AttributeList Color = ColorAttributeList
type ColorAttributeList = ('[ '("red", ColorRedFieldInfo), '("green", ColorGreenFieldInfo), '("blue", ColorBlueFieldInfo)] :: [(Symbol, *)])
#endif

-- method Color::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "color to copy, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Color" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_color_copy" pango_color_copy :: 
    Ptr Color ->                            -- src : TInterface (Name {namespace = "Pango", name = "Color"})
    IO (Ptr Color)

-- | Creates a copy of /@src@/, which should be freed with
-- 'GI.Pango.Structs.Color.colorFree'. Primarily used by language bindings,
-- not that useful otherwise (since colors can just be copied
-- by assignment in C).
colorCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@src@/: color to copy, may be 'P.Nothing'
    -> m (Maybe Color)
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.Color.Color', which
    --               should be freed with 'GI.Pango.Structs.Color.colorFree', or 'P.Nothing' if
    --               /@src@/ was 'P.Nothing'.
colorCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> m (Maybe Color)
colorCopy Color
src = IO (Maybe Color) -> m (Maybe Color)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Color) -> m (Maybe Color))
-> IO (Maybe Color) -> m (Maybe Color)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
src' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
src
    Ptr Color
result <- Ptr Color -> IO (Ptr Color)
pango_color_copy Ptr Color
src'
    Maybe Color
maybeResult <- Ptr Color -> (Ptr Color -> IO Color) -> IO (Maybe Color)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Color
result ((Ptr Color -> IO Color) -> IO (Maybe Color))
-> (Ptr Color -> IO Color) -> IO (Maybe Color)
forall a b. (a -> b) -> a -> b
$ \Ptr Color
result' -> do
        Color
result'' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Color) Ptr Color
result'
        Color -> IO Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result''
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
src
    Maybe Color -> IO (Maybe Color)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Color
maybeResult

#if defined(ENABLE_OVERLOADING)
data ColorCopyMethodInfo
instance (signature ~ (m (Maybe Color)), MonadIO m) => O.OverloadedMethod ColorCopyMethodInfo Color signature where
    overloadedMethod = colorCopy

instance O.OverloadedMethodInfo ColorCopyMethodInfo Color where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Pango.Structs.Color.colorCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-pango-1.0.24/docs/GI-Pango-Structs-Color.html#v:colorCopy"
        }


#endif

-- method Color::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an allocated #PangoColor, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_color_free" pango_color_free :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Pango", name = "Color"})
    IO ()

-- | Frees a color allocated by 'GI.Pango.Structs.Color.colorCopy'.
colorFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: an allocated t'GI.Pango.Structs.Color.Color', may be 'P.Nothing'
    -> m ()
colorFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m ()
colorFree Color
color = 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 Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Color -> IO ()
pango_color_free Ptr Color
color'
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColorFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ColorFreeMethodInfo Color signature where
    overloadedMethod = colorFree

instance O.OverloadedMethodInfo ColorFreeMethodInfo Color where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Pango.Structs.Color.colorFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-pango-1.0.24/docs/GI-Pango-Structs-Color.html#v:colorFree"
        }


#endif

-- method Color::parse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #PangoColor structure in which to store the\n  result, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spec"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string specifying the new color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_color_parse" pango_color_parse :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Pango", name = "Color"})
    CString ->                              -- spec : TBasicType TUTF8
    IO CInt

-- | Fill in the fields of a color from a string specification. The
-- string can either one of a large set of standard names. (Taken
-- from the CSS \<ulink url=\"http:\/\/dev.w3.org\/csswg\/css-color\/@/named/@-colors\">specification\<\/ulink>), or it can be a hexadecimal
-- value in the
-- form \'&num;rgb\' \'&num;rrggbb\' \'&num;rrrgggbbb\' or \'&num;rrrrggggbbbb\' where
-- \'r\', \'g\' and \'b\' are hex digits of the red, green, and blue
-- components of the color, respectively. (White in the four
-- forms is \'&num;fff\' \'&num;ffffff\' \'&num;fffffffff\' and \'&num;ffffffffffff\')
colorParse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Pango.Structs.Color.Color' structure in which to store the
    --   result, or 'P.Nothing'
    -> T.Text
    -- ^ /@spec@/: a string specifying the new color
    -> m Bool
    -- ^ __Returns:__ 'P.True' if parsing of the specifier succeeded,
    --   otherwise false.
colorParse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Text -> m Bool
colorParse Color
color Text
spec = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CString
spec' <- Text -> IO CString
textToCString Text
spec
    CInt
result <- Ptr Color -> CString -> IO CInt
pango_color_parse Ptr Color
color' CString
spec'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
spec'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ColorParseMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod ColorParseMethodInfo Color signature where
    overloadedMethod = colorParse

instance O.OverloadedMethodInfo ColorParseMethodInfo Color where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Pango.Structs.Color.colorParse",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-pango-1.0.24/docs/GI-Pango-Structs-Color.html#v:colorParse"
        }


#endif

-- method Color::parse_with_alpha
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #PangoColor structure in which to store the\n  result, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TUInt16
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for alpha, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "spec"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string specifying the new color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_color_parse_with_alpha" pango_color_parse_with_alpha :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Pango", name = "Color"})
    Ptr Word16 ->                           -- alpha : TBasicType TUInt16
    CString ->                              -- spec : TBasicType TUTF8
    IO CInt

-- | Fill in the fields of a color from a string specification. The
-- string can either one of a large set of standard names. (Taken
-- from the CSS \<ulink url=\"http:\/\/dev.w3.org\/csswg\/css-color\/@/named/@-colors\">specification\<\/ulink>), or it can be a hexadecimal
-- value in the
-- form \'&num;rgb\' \'&num;rrggbb\' \'&num;rrrgggbbb\' or \'&num;rrrrggggbbbb\' where
-- \'r\', \'g\' and \'b\' are hex digits of the red, green, and blue
-- components of the color, respectively. (White in the four
-- forms is \'&num;fff\' \'&num;ffffff\' \'&num;fffffffff\' and \'&num;ffffffffffff\')
-- 
-- Additionally, parse strings of the form
-- \'&num;rgba\', \'&num;rrggbbaa\', \'&num;rrrrggggbbbbaaaa\',
-- if /@alpha@/ is not 'P.Nothing', and set /@alpha@/ to the value specified
-- by the hex digits for \'a\'. If no alpha component is found
-- in /@spec@/, /@alpha@/ is set to 0xffff (for a solid color).
-- 
-- /Since: 1.46/
colorParseWithAlpha ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Pango.Structs.Color.Color' structure in which to store the
    --   result, or 'P.Nothing'
    -> T.Text
    -- ^ /@spec@/: a string specifying the new color
    -> m ((Bool, Word16))
    -- ^ __Returns:__ 'P.True' if parsing of the specifier succeeded,
    --   otherwise false.
colorParseWithAlpha :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Color -> Text -> m (Bool, Word16)
colorParseWithAlpha Color
color Text
spec = IO (Bool, Word16) -> m (Bool, Word16)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word16) -> m (Bool, Word16))
-> IO (Bool, Word16) -> m (Bool, Word16)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Word16
alpha <- IO (Ptr Word16)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word16)
    CString
spec' <- Text -> IO CString
textToCString Text
spec
    CInt
result <- Ptr Color -> Ptr Word16 -> CString -> IO CInt
pango_color_parse_with_alpha Ptr Color
color' Ptr Word16
alpha CString
spec'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word16
alpha' <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek Ptr Word16
alpha
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Ptr Word16 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word16
alpha
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
spec'
    (Bool, Word16) -> IO (Bool, Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word16
alpha')

#if defined(ENABLE_OVERLOADING)
data ColorParseWithAlphaMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word16))), MonadIO m) => O.OverloadedMethod ColorParseWithAlphaMethodInfo Color signature where
    overloadedMethod = colorParseWithAlpha

instance O.OverloadedMethodInfo ColorParseWithAlphaMethodInfo Color where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Pango.Structs.Color.colorParseWithAlpha",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-pango-1.0.24/docs/GI-Pango-Structs-Color.html#v:colorParseWithAlpha"
        }


#endif

-- method Color::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoColor" , 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 "pango_color_to_string" pango_color_to_string :: 
    Ptr Color ->                            -- color : TInterface (Name {namespace = "Pango", name = "Color"})
    IO CString

-- | Returns a textual specification of /@color@/ in the hexadecimal form
-- \<literal>&num;rrrrggggbbbb\<\/literal>, where \<literal>r\<\/literal>,
-- \<literal>g\<\/literal> and \<literal>b\<\/literal> are hex digits representing
-- the red, green, and blue components respectively.
-- 
-- /Since: 1.16/
colorToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Color
    -- ^ /@color@/: a t'GI.Pango.Structs.Color.Color'
    -> m T.Text
    -- ^ __Returns:__ a newly-allocated text string that must be freed with 'GI.GLib.Functions.free'.
colorToString :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Color -> m Text
colorToString Color
color = 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 Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    CString
result <- Ptr Color -> IO CString
pango_color_to_string Ptr Color
color'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"colorToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ColorToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod ColorToStringMethodInfo Color signature where
    overloadedMethod = colorToString

instance O.OverloadedMethodInfo ColorToStringMethodInfo Color where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Pango.Structs.Color.colorToString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-pango-1.0.24/docs/GI-Pango-Structs-Color.html#v:colorToString"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveColorMethod (t :: Symbol) (o :: *) :: * where
    ResolveColorMethod "copy" o = ColorCopyMethodInfo
    ResolveColorMethod "free" o = ColorFreeMethodInfo
    ResolveColorMethod "parse" o = ColorParseMethodInfo
    ResolveColorMethod "parseWithAlpha" o = ColorParseWithAlphaMethodInfo
    ResolveColorMethod "toString" o = ColorToStringMethodInfo
    ResolveColorMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif