{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A render node for an inset shadow.

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

module GI.Gsk.Objects.InsetShadowNode
    ( 

-- * Exported types
    InsetShadowNode(..)                     ,
    IsInsetShadowNode                       ,
    toInsetShadowNode                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [draw]("GI.Gsk.Objects.RenderNode#g:method:draw"), [ref]("GI.Gsk.Objects.RenderNode#g:method:ref"), [serialize]("GI.Gsk.Objects.RenderNode#g:method:serialize"), [unref]("GI.Gsk.Objects.RenderNode#g:method:unref"), [writeToFile]("GI.Gsk.Objects.RenderNode#g:method:writeToFile").
-- 
-- ==== Getters
-- [getBlurRadius]("GI.Gsk.Objects.InsetShadowNode#g:method:getBlurRadius"), [getBounds]("GI.Gsk.Objects.RenderNode#g:method:getBounds"), [getColor]("GI.Gsk.Objects.InsetShadowNode#g:method:getColor"), [getDx]("GI.Gsk.Objects.InsetShadowNode#g:method:getDx"), [getDy]("GI.Gsk.Objects.InsetShadowNode#g:method:getDy"), [getNodeType]("GI.Gsk.Objects.RenderNode#g:method:getNodeType"), [getOutline]("GI.Gsk.Objects.InsetShadowNode#g:method:getOutline"), [getSpread]("GI.Gsk.Objects.InsetShadowNode#g:method:getSpread").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveInsetShadowNodeMethod            ,
#endif

-- ** getBlurRadius #method:getBlurRadius#

#if defined(ENABLE_OVERLOADING)
    InsetShadowNodeGetBlurRadiusMethodInfo  ,
#endif
    insetShadowNodeGetBlurRadius            ,


-- ** getColor #method:getColor#

#if defined(ENABLE_OVERLOADING)
    InsetShadowNodeGetColorMethodInfo       ,
#endif
    insetShadowNodeGetColor                 ,


-- ** getDx #method:getDx#

#if defined(ENABLE_OVERLOADING)
    InsetShadowNodeGetDxMethodInfo          ,
#endif
    insetShadowNodeGetDx                    ,


-- ** getDy #method:getDy#

#if defined(ENABLE_OVERLOADING)
    InsetShadowNodeGetDyMethodInfo          ,
#endif
    insetShadowNodeGetDy                    ,


-- ** getOutline #method:getOutline#

#if defined(ENABLE_OVERLOADING)
    InsetShadowNodeGetOutlineMethodInfo     ,
#endif
    insetShadowNodeGetOutline               ,


-- ** getSpread #method:getSpread#

#if defined(ENABLE_OVERLOADING)
    InsetShadowNodeGetSpreadMethodInfo      ,
#endif
    insetShadowNodeGetSpread                ,


-- ** new #method:new#

    insetShadowNodeNew                      ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import {-# SOURCE #-} qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import {-# SOURCE #-} qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect

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

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

foreign import ccall "gsk_inset_shadow_node_get_type"
    c_gsk_inset_shadow_node_get_type :: IO B.Types.GType

instance B.Types.TypedObject InsetShadowNode where
    glibType :: IO GType
glibType = IO GType
c_gsk_inset_shadow_node_get_type

-- | Type class for types which can be safely cast to `InsetShadowNode`, for instance with `toInsetShadowNode`.
class (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf InsetShadowNode o) => IsInsetShadowNode o
instance (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf InsetShadowNode o) => IsInsetShadowNode o

instance O.HasParentTypes InsetShadowNode
type instance O.ParentTypes InsetShadowNode = '[Gsk.RenderNode.RenderNode]

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

--- XXX Missing getter and/or setter, so no GValue instance could be generated.
#if defined(ENABLE_OVERLOADING)
type family ResolveInsetShadowNodeMethod (t :: Symbol) (o :: *) :: * where
    ResolveInsetShadowNodeMethod "draw" o = Gsk.RenderNode.RenderNodeDrawMethodInfo
    ResolveInsetShadowNodeMethod "ref" o = Gsk.RenderNode.RenderNodeRefMethodInfo
    ResolveInsetShadowNodeMethod "serialize" o = Gsk.RenderNode.RenderNodeSerializeMethodInfo
    ResolveInsetShadowNodeMethod "unref" o = Gsk.RenderNode.RenderNodeUnrefMethodInfo
    ResolveInsetShadowNodeMethod "writeToFile" o = Gsk.RenderNode.RenderNodeWriteToFileMethodInfo
    ResolveInsetShadowNodeMethod "getBlurRadius" o = InsetShadowNodeGetBlurRadiusMethodInfo
    ResolveInsetShadowNodeMethod "getBounds" o = Gsk.RenderNode.RenderNodeGetBoundsMethodInfo
    ResolveInsetShadowNodeMethod "getColor" o = InsetShadowNodeGetColorMethodInfo
    ResolveInsetShadowNodeMethod "getDx" o = InsetShadowNodeGetDxMethodInfo
    ResolveInsetShadowNodeMethod "getDy" o = InsetShadowNodeGetDyMethodInfo
    ResolveInsetShadowNodeMethod "getNodeType" o = Gsk.RenderNode.RenderNodeGetNodeTypeMethodInfo
    ResolveInsetShadowNodeMethod "getOutline" o = InsetShadowNodeGetOutlineMethodInfo
    ResolveInsetShadowNodeMethod "getSpread" o = InsetShadowNodeGetSpreadMethodInfo
    ResolveInsetShadowNodeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr InsetShadowNode where
    boxedPtrCopy :: InsetShadowNode -> IO InsetShadowNode
boxedPtrCopy = InsetShadowNode -> IO InsetShadowNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: InsetShadowNode -> IO ()
boxedPtrFree = \InsetShadowNode
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- method InsetShadowNode::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "outline"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "outline of the region containing the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "color of the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "horizontal offset of shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "vertical offset of shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spread"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "how far the shadow spreads towards the inside"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blur_radius"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "how much blur to apply to the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gsk" , name = "InsetShadowNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_inset_shadow_node_new" gsk_inset_shadow_node_new :: 
    Ptr Gsk.RoundedRect.RoundedRect ->      -- outline : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr Gdk.RGBA.RGBA ->                    -- color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    CFloat ->                               -- dx : TBasicType TFloat
    CFloat ->                               -- dy : TBasicType TFloat
    CFloat ->                               -- spread : TBasicType TFloat
    CFloat ->                               -- blur_radius : TBasicType TFloat
    IO (Ptr InsetShadowNode)

-- | Creates a @GskRenderNode@ that will render an inset shadow
-- into the box given by /@outline@/.
insetShadowNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gsk.RoundedRect.RoundedRect
    -- ^ /@outline@/: outline of the region containing the shadow
    -> Gdk.RGBA.RGBA
    -- ^ /@color@/: color of the shadow
    -> Float
    -- ^ /@dx@/: horizontal offset of shadow
    -> Float
    -- ^ /@dy@/: vertical offset of shadow
    -> Float
    -- ^ /@spread@/: how far the shadow spreads towards the inside
    -> Float
    -- ^ /@blurRadius@/: how much blur to apply to the shadow
    -> m InsetShadowNode
    -- ^ __Returns:__ A new @GskRenderNode@
insetShadowNodeNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect
-> RGBA -> Float -> Float -> Float -> Float -> m InsetShadowNode
insetShadowNodeNew RoundedRect
outline RGBA
color Float
dx Float
dy Float
spread Float
blurRadius = IO InsetShadowNode -> m InsetShadowNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InsetShadowNode -> m InsetShadowNode)
-> IO InsetShadowNode -> m InsetShadowNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr RoundedRect
outline' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
outline
    Ptr RGBA
color' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
color
    let dx' :: CFloat
dx' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dx
    let dy' :: CFloat
dy' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dy
    let spread' :: CFloat
spread' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spread
    let blurRadius' :: CFloat
blurRadius' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
blurRadius
    Ptr InsetShadowNode
result <- Ptr RoundedRect
-> Ptr RGBA
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> IO (Ptr InsetShadowNode)
gsk_inset_shadow_node_new Ptr RoundedRect
outline' Ptr RGBA
color' CFloat
dx' CFloat
dy' CFloat
spread' CFloat
blurRadius'
    Text -> Ptr InsetShadowNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"insetShadowNodeNew" Ptr InsetShadowNode
result
    InsetShadowNode
result' <- ((ManagedPtr InsetShadowNode -> InsetShadowNode)
-> Ptr InsetShadowNode -> IO InsetShadowNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr InsetShadowNode -> InsetShadowNode
InsetShadowNode) Ptr InsetShadowNode
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
outline
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
color
    InsetShadowNode -> IO InsetShadowNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InsetShadowNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method InsetShadowNode::get_blur_radius
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "InsetShadowNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode` for an inset shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_inset_shadow_node_get_blur_radius" gsk_inset_shadow_node_get_blur_radius :: 
    Ptr InsetShadowNode ->                  -- node : TInterface (Name {namespace = "Gsk", name = "InsetShadowNode"})
    IO CFloat

-- | Retrieves the blur radius to apply to the shadow.
insetShadowNodeGetBlurRadius ::
    (B.CallStack.HasCallStack, MonadIO m, IsInsetShadowNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for an inset shadow
    -> m Float
    -- ^ __Returns:__ the blur radius, in pixels
insetShadowNodeGetBlurRadius :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInsetShadowNode a) =>
a -> m Float
insetShadowNodeGetBlurRadius a
node = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr InsetShadowNode
node' <- a -> IO (Ptr InsetShadowNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    CFloat
result <- Ptr InsetShadowNode -> IO CFloat
gsk_inset_shadow_node_get_blur_radius Ptr InsetShadowNode
node'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data InsetShadowNodeGetBlurRadiusMethodInfo
instance (signature ~ (m Float), MonadIO m, IsInsetShadowNode a) => O.OverloadedMethod InsetShadowNodeGetBlurRadiusMethodInfo a signature where
    overloadedMethod = insetShadowNodeGetBlurRadius

instance O.OverloadedMethodInfo InsetShadowNodeGetBlurRadiusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.InsetShadowNode.insetShadowNodeGetBlurRadius",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-InsetShadowNode.html#v:insetShadowNodeGetBlurRadius"
        })


#endif

-- method InsetShadowNode::get_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "InsetShadowNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode` for an inset shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "RGBA" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_inset_shadow_node_get_color" gsk_inset_shadow_node_get_color :: 
    Ptr InsetShadowNode ->                  -- node : TInterface (Name {namespace = "Gsk", name = "InsetShadowNode"})
    IO (Ptr Gdk.RGBA.RGBA)

-- | Retrieves the color of the inset shadow.
insetShadowNodeGetColor ::
    (B.CallStack.HasCallStack, MonadIO m, IsInsetShadowNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for an inset shadow
    -> m Gdk.RGBA.RGBA
    -- ^ __Returns:__ the color of the shadow
insetShadowNodeGetColor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInsetShadowNode a) =>
a -> m RGBA
insetShadowNodeGetColor a
node = IO RGBA -> m RGBA
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RGBA -> m RGBA) -> IO RGBA -> m RGBA
forall a b. (a -> b) -> a -> b
$ do
    Ptr InsetShadowNode
node' <- a -> IO (Ptr InsetShadowNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RGBA
result <- Ptr InsetShadowNode -> IO (Ptr RGBA)
gsk_inset_shadow_node_get_color Ptr InsetShadowNode
node'
    Text -> Ptr RGBA -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"insetShadowNodeGetColor" Ptr RGBA
result
    RGBA
result' <- ((ManagedPtr RGBA -> RGBA) -> Ptr RGBA -> IO RGBA
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr RGBA -> RGBA
Gdk.RGBA.RGBA) Ptr RGBA
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    RGBA -> IO RGBA
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RGBA
result'

#if defined(ENABLE_OVERLOADING)
data InsetShadowNodeGetColorMethodInfo
instance (signature ~ (m Gdk.RGBA.RGBA), MonadIO m, IsInsetShadowNode a) => O.OverloadedMethod InsetShadowNodeGetColorMethodInfo a signature where
    overloadedMethod = insetShadowNodeGetColor

instance O.OverloadedMethodInfo InsetShadowNodeGetColorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.InsetShadowNode.insetShadowNodeGetColor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-InsetShadowNode.html#v:insetShadowNodeGetColor"
        })


#endif

-- method InsetShadowNode::get_dx
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "InsetShadowNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode` for an inset shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_inset_shadow_node_get_dx" gsk_inset_shadow_node_get_dx :: 
    Ptr InsetShadowNode ->                  -- node : TInterface (Name {namespace = "Gsk", name = "InsetShadowNode"})
    IO CFloat

-- | Retrieves the horizontal offset of the inset shadow.
insetShadowNodeGetDx ::
    (B.CallStack.HasCallStack, MonadIO m, IsInsetShadowNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for an inset shadow
    -> m Float
    -- ^ __Returns:__ an offset, in pixels
insetShadowNodeGetDx :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInsetShadowNode a) =>
a -> m Float
insetShadowNodeGetDx a
node = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr InsetShadowNode
node' <- a -> IO (Ptr InsetShadowNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    CFloat
result <- Ptr InsetShadowNode -> IO CFloat
gsk_inset_shadow_node_get_dx Ptr InsetShadowNode
node'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data InsetShadowNodeGetDxMethodInfo
instance (signature ~ (m Float), MonadIO m, IsInsetShadowNode a) => O.OverloadedMethod InsetShadowNodeGetDxMethodInfo a signature where
    overloadedMethod = insetShadowNodeGetDx

instance O.OverloadedMethodInfo InsetShadowNodeGetDxMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.InsetShadowNode.insetShadowNodeGetDx",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-InsetShadowNode.html#v:insetShadowNodeGetDx"
        })


#endif

-- method InsetShadowNode::get_dy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "InsetShadowNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode` for an inset shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_inset_shadow_node_get_dy" gsk_inset_shadow_node_get_dy :: 
    Ptr InsetShadowNode ->                  -- node : TInterface (Name {namespace = "Gsk", name = "InsetShadowNode"})
    IO CFloat

-- | Retrieves the vertical offset of the inset shadow.
insetShadowNodeGetDy ::
    (B.CallStack.HasCallStack, MonadIO m, IsInsetShadowNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for an inset shadow
    -> m Float
    -- ^ __Returns:__ an offset, in pixels
insetShadowNodeGetDy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInsetShadowNode a) =>
a -> m Float
insetShadowNodeGetDy a
node = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr InsetShadowNode
node' <- a -> IO (Ptr InsetShadowNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    CFloat
result <- Ptr InsetShadowNode -> IO CFloat
gsk_inset_shadow_node_get_dy Ptr InsetShadowNode
node'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data InsetShadowNodeGetDyMethodInfo
instance (signature ~ (m Float), MonadIO m, IsInsetShadowNode a) => O.OverloadedMethod InsetShadowNodeGetDyMethodInfo a signature where
    overloadedMethod = insetShadowNodeGetDy

instance O.OverloadedMethodInfo InsetShadowNodeGetDyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.InsetShadowNode.insetShadowNodeGetDy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-InsetShadowNode.html#v:insetShadowNodeGetDy"
        })


#endif

-- method InsetShadowNode::get_outline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "InsetShadowNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode` for an inset shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RoundedRect" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_inset_shadow_node_get_outline" gsk_inset_shadow_node_get_outline :: 
    Ptr InsetShadowNode ->                  -- node : TInterface (Name {namespace = "Gsk", name = "InsetShadowNode"})
    IO (Ptr Gsk.RoundedRect.RoundedRect)

-- | Retrieves the outline rectangle of the inset shadow.
insetShadowNodeGetOutline ::
    (B.CallStack.HasCallStack, MonadIO m, IsInsetShadowNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for an inset shadow
    -> m Gsk.RoundedRect.RoundedRect
    -- ^ __Returns:__ a rounded rectangle
insetShadowNodeGetOutline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInsetShadowNode a) =>
a -> m RoundedRect
insetShadowNodeGetOutline a
node = IO RoundedRect -> m RoundedRect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ do
    Ptr InsetShadowNode
node' <- a -> IO (Ptr InsetShadowNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RoundedRect
result <- Ptr InsetShadowNode -> IO (Ptr RoundedRect)
gsk_inset_shadow_node_get_outline Ptr InsetShadowNode
node'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"insetShadowNodeGetOutline" Ptr RoundedRect
result
    RoundedRect
result' <- ((ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedRect -> RoundedRect
Gsk.RoundedRect.RoundedRect) Ptr RoundedRect
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    RoundedRect -> IO RoundedRect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
data InsetShadowNodeGetOutlineMethodInfo
instance (signature ~ (m Gsk.RoundedRect.RoundedRect), MonadIO m, IsInsetShadowNode a) => O.OverloadedMethod InsetShadowNodeGetOutlineMethodInfo a signature where
    overloadedMethod = insetShadowNodeGetOutline

instance O.OverloadedMethodInfo InsetShadowNodeGetOutlineMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.InsetShadowNode.insetShadowNodeGetOutline",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-InsetShadowNode.html#v:insetShadowNodeGetOutline"
        })


#endif

-- method InsetShadowNode::get_spread
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "InsetShadowNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode` for an inset shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_inset_shadow_node_get_spread" gsk_inset_shadow_node_get_spread :: 
    Ptr InsetShadowNode ->                  -- node : TInterface (Name {namespace = "Gsk", name = "InsetShadowNode"})
    IO CFloat

-- | Retrieves how much the shadow spreads inwards.
insetShadowNodeGetSpread ::
    (B.CallStack.HasCallStack, MonadIO m, IsInsetShadowNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for an inset shadow
    -> m Float
    -- ^ __Returns:__ the size of the shadow, in pixels
insetShadowNodeGetSpread :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInsetShadowNode a) =>
a -> m Float
insetShadowNodeGetSpread a
node = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr InsetShadowNode
node' <- a -> IO (Ptr InsetShadowNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    CFloat
result <- Ptr InsetShadowNode -> IO CFloat
gsk_inset_shadow_node_get_spread Ptr InsetShadowNode
node'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data InsetShadowNodeGetSpreadMethodInfo
instance (signature ~ (m Float), MonadIO m, IsInsetShadowNode a) => O.OverloadedMethod InsetShadowNodeGetSpreadMethodInfo a signature where
    overloadedMethod = insetShadowNodeGetSpread

instance O.OverloadedMethodInfo InsetShadowNodeGetSpreadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.InsetShadowNode.insetShadowNodeGetSpread",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-InsetShadowNode.html#v:insetShadowNodeGetSpread"
        })


#endif