{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gsk.Structs.Shadow
    ( 

-- * Exported types
    Shadow(..)                              ,
    newZeroShadow                           ,
    noShadow                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveShadowMethod                     ,
#endif


-- ** nodeGetChild #method:nodeGetChild#

    shadowNodeGetChild                      ,


-- ** nodeGetNShadows #method:nodeGetNShadows#

    shadowNodeGetNShadows                   ,


-- ** nodeNew #method:nodeNew#

    shadowNodeNew                           ,


-- ** nodePeekShadow #method:nodePeekShadow#

    shadowNodePeekShadow                    ,




 -- * Properties
-- ** color #attr:color#
-- | /No description available in the introspection data./

    getShadowColor                          ,
#if defined(ENABLE_OVERLOADING)
    shadow_color                            ,
#endif


-- ** dx #attr:dx#
-- | /No description available in the introspection data./

    getShadowDx                             ,
    setShadowDx                             ,
#if defined(ENABLE_OVERLOADING)
    shadow_dx                               ,
#endif


-- ** dy #attr:dy#
-- | /No description available in the introspection data./

    getShadowDy                             ,
    setShadowDy                             ,
#if defined(ENABLE_OVERLOADING)
    shadow_dy                               ,
#endif


-- ** radius #attr:radius#
-- | /No description available in the introspection data./

    getShadowRadius                         ,
    setShadowRadius                         ,
#if defined(ENABLE_OVERLOADING)
    shadow_radius                           ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

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

-- | Memory-managed wrapper type.
newtype Shadow = Shadow (ManagedPtr Shadow)
    deriving (Shadow -> Shadow -> Bool
(Shadow -> Shadow -> Bool)
-> (Shadow -> Shadow -> Bool) -> Eq Shadow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shadow -> Shadow -> Bool
$c/= :: Shadow -> Shadow -> Bool
== :: Shadow -> Shadow -> Bool
$c== :: Shadow -> Shadow -> Bool
Eq)
instance WrappedPtr Shadow where
    wrappedPtrCalloc :: IO (Ptr Shadow)
wrappedPtrCalloc = Int -> IO (Ptr Shadow)
forall a. Int -> IO (Ptr a)
callocBytes 48
    wrappedPtrCopy :: Shadow -> IO Shadow
wrappedPtrCopy = \p :: Shadow
p -> Shadow -> (Ptr Shadow -> IO Shadow) -> IO Shadow
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Shadow
p (Int -> Ptr Shadow -> IO (Ptr Shadow)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 48 (Ptr Shadow -> IO (Ptr Shadow))
-> (Ptr Shadow -> IO Shadow) -> Ptr Shadow -> IO Shadow
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr Shadow -> Shadow) -> Ptr Shadow -> IO Shadow
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Shadow -> Shadow
Shadow)
    wrappedPtrFree :: Maybe (GDestroyNotify Shadow)
wrappedPtrFree = GDestroyNotify Shadow -> Maybe (GDestroyNotify Shadow)
forall a. a -> Maybe a
Just GDestroyNotify Shadow
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `Shadow` struct initialized to zero.
newZeroShadow :: MonadIO m => m Shadow
newZeroShadow :: m Shadow
newZeroShadow = IO Shadow -> m Shadow
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Shadow -> m Shadow) -> IO Shadow -> m Shadow
forall a b. (a -> b) -> a -> b
$ IO (Ptr Shadow)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr Shadow) -> (Ptr Shadow -> IO Shadow) -> IO Shadow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Shadow -> Shadow) -> Ptr Shadow -> IO Shadow
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Shadow -> Shadow
Shadow

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


-- | A convenience alias for `Nothing` :: `Maybe` `Shadow`.
noShadow :: Maybe Shadow
noShadow :: Maybe Shadow
noShadow = Maybe Shadow
forall a. Maybe a
Nothing

-- | Get the value of the “@color@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shadow #color
-- @
getShadowColor :: MonadIO m => Shadow -> m Gdk.RGBA.RGBA
getShadowColor :: Shadow -> m RGBA
getShadowColor s :: Shadow
s = IO RGBA -> m RGBA
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
$ Shadow -> (Ptr Shadow -> IO RGBA) -> IO RGBA
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Shadow
s ((Ptr Shadow -> IO RGBA) -> IO RGBA)
-> (Ptr Shadow -> IO RGBA) -> IO RGBA
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Shadow
ptr -> do
    let val :: Ptr RGBA
val = Ptr Shadow
ptr Ptr Shadow -> Int -> Ptr RGBA
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Gdk.RGBA.RGBA)
    RGBA
val' <- ((ManagedPtr RGBA -> RGBA) -> Ptr RGBA -> IO RGBA
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr RGBA -> RGBA
Gdk.RGBA.RGBA) Ptr RGBA
val
    RGBA -> IO RGBA
forall (m :: * -> *) a. Monad m => a -> m a
return RGBA
val'

#if defined(ENABLE_OVERLOADING)
data ShadowColorFieldInfo
instance AttrInfo ShadowColorFieldInfo where
    type AttrBaseTypeConstraint ShadowColorFieldInfo = (~) Shadow
    type AttrAllowedOps ShadowColorFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ShadowColorFieldInfo = (~) (Ptr Gdk.RGBA.RGBA)
    type AttrTransferTypeConstraint ShadowColorFieldInfo = (~)(Ptr Gdk.RGBA.RGBA)
    type AttrTransferType ShadowColorFieldInfo = (Ptr Gdk.RGBA.RGBA)
    type AttrGetType ShadowColorFieldInfo = Gdk.RGBA.RGBA
    type AttrLabel ShadowColorFieldInfo = "color"
    type AttrOrigin ShadowColorFieldInfo = Shadow
    attrGet = getShadowColor
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

shadow_color :: AttrLabelProxy "color"
shadow_color = AttrLabelProxy

#endif


-- | Get the value of the “@dx@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shadow #dx
-- @
getShadowDx :: MonadIO m => Shadow -> m Float
getShadowDx :: Shadow -> m Float
getShadowDx s :: Shadow
s = IO Float -> m Float
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
$ Shadow -> (Ptr Shadow -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Shadow
s ((Ptr Shadow -> IO Float) -> IO Float)
-> (Ptr Shadow -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Shadow
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Shadow
ptr Ptr Shadow -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@dx@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shadow [ #dx 'Data.GI.Base.Attributes.:=' value ]
-- @
setShadowDx :: MonadIO m => Shadow -> Float -> m ()
setShadowDx :: Shadow -> Float -> m ()
setShadowDx s :: Shadow
s val :: Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Shadow -> (Ptr Shadow -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Shadow
s ((Ptr Shadow -> IO ()) -> IO ()) -> (Ptr Shadow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Shadow
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Shadow
ptr Ptr Shadow -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data ShadowDxFieldInfo
instance AttrInfo ShadowDxFieldInfo where
    type AttrBaseTypeConstraint ShadowDxFieldInfo = (~) Shadow
    type AttrAllowedOps ShadowDxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ShadowDxFieldInfo = (~) Float
    type AttrTransferTypeConstraint ShadowDxFieldInfo = (~)Float
    type AttrTransferType ShadowDxFieldInfo = Float
    type AttrGetType ShadowDxFieldInfo = Float
    type AttrLabel ShadowDxFieldInfo = "dx"
    type AttrOrigin ShadowDxFieldInfo = Shadow
    attrGet = getShadowDx
    attrSet = setShadowDx
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

shadow_dx :: AttrLabelProxy "dx"
shadow_dx = AttrLabelProxy

#endif


-- | Get the value of the “@dy@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shadow #dy
-- @
getShadowDy :: MonadIO m => Shadow -> m Float
getShadowDy :: Shadow -> m Float
getShadowDy s :: Shadow
s = IO Float -> m Float
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
$ Shadow -> (Ptr Shadow -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Shadow
s ((Ptr Shadow -> IO Float) -> IO Float)
-> (Ptr Shadow -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Shadow
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Shadow
ptr Ptr Shadow -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@dy@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shadow [ #dy 'Data.GI.Base.Attributes.:=' value ]
-- @
setShadowDy :: MonadIO m => Shadow -> Float -> m ()
setShadowDy :: Shadow -> Float -> m ()
setShadowDy s :: Shadow
s val :: Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Shadow -> (Ptr Shadow -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Shadow
s ((Ptr Shadow -> IO ()) -> IO ()) -> (Ptr Shadow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Shadow
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Shadow
ptr Ptr Shadow -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data ShadowDyFieldInfo
instance AttrInfo ShadowDyFieldInfo where
    type AttrBaseTypeConstraint ShadowDyFieldInfo = (~) Shadow
    type AttrAllowedOps ShadowDyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ShadowDyFieldInfo = (~) Float
    type AttrTransferTypeConstraint ShadowDyFieldInfo = (~)Float
    type AttrTransferType ShadowDyFieldInfo = Float
    type AttrGetType ShadowDyFieldInfo = Float
    type AttrLabel ShadowDyFieldInfo = "dy"
    type AttrOrigin ShadowDyFieldInfo = Shadow
    attrGet = getShadowDy
    attrSet = setShadowDy
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

shadow_dy :: AttrLabelProxy "dy"
shadow_dy = AttrLabelProxy

#endif


-- | Get the value of the “@radius@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shadow #radius
-- @
getShadowRadius :: MonadIO m => Shadow -> m Float
getShadowRadius :: Shadow -> m Float
getShadowRadius s :: Shadow
s = IO Float -> m Float
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
$ Shadow -> (Ptr Shadow -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Shadow
s ((Ptr Shadow -> IO Float) -> IO Float)
-> (Ptr Shadow -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Shadow
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Shadow
ptr Ptr Shadow -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@radius@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shadow [ #radius 'Data.GI.Base.Attributes.:=' value ]
-- @
setShadowRadius :: MonadIO m => Shadow -> Float -> m ()
setShadowRadius :: Shadow -> Float -> m ()
setShadowRadius s :: Shadow
s val :: Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Shadow -> (Ptr Shadow -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Shadow
s ((Ptr Shadow -> IO ()) -> IO ()) -> (Ptr Shadow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Shadow
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Shadow
ptr Ptr Shadow -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data ShadowRadiusFieldInfo
instance AttrInfo ShadowRadiusFieldInfo where
    type AttrBaseTypeConstraint ShadowRadiusFieldInfo = (~) Shadow
    type AttrAllowedOps ShadowRadiusFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ShadowRadiusFieldInfo = (~) Float
    type AttrTransferTypeConstraint ShadowRadiusFieldInfo = (~)Float
    type AttrTransferType ShadowRadiusFieldInfo = Float
    type AttrGetType ShadowRadiusFieldInfo = Float
    type AttrLabel ShadowRadiusFieldInfo = "radius"
    type AttrOrigin ShadowRadiusFieldInfo = Shadow
    attrGet = getShadowRadius
    attrSet = setShadowRadius
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

shadow_radius :: AttrLabelProxy "radius"
shadow_radius = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Shadow
type instance O.AttributeList Shadow = ShadowAttributeList
type ShadowAttributeList = ('[ '("color", ShadowColorFieldInfo), '("dx", ShadowDxFieldInfo), '("dy", ShadowDyFieldInfo), '("radius", ShadowRadiusFieldInfo)] :: [(Symbol, *)])
#endif

-- method Shadow::node_get_child
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RenderNode" })
-- throws : False
-- Skip return : False

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

-- | /No description available in the introspection data./
shadowNodeGetChild ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gsk.RenderNode.RenderNode
    -> m Gsk.RenderNode.RenderNode
shadowNodeGetChild :: RenderNode -> m RenderNode
shadowNodeGetChild node :: RenderNode
node = IO RenderNode -> m RenderNode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RenderNode -> m RenderNode) -> IO RenderNode -> m RenderNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr RenderNode
node' <- RenderNode -> IO (Ptr RenderNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RenderNode
node
    Ptr RenderNode
result <- Ptr RenderNode -> IO (Ptr RenderNode)
gsk_shadow_node_get_child Ptr RenderNode
node'
    Text -> Ptr RenderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "shadowNodeGetChild" Ptr RenderNode
result
    RenderNode
result' <- ((ManagedPtr RenderNode -> RenderNode)
-> Ptr RenderNode -> IO RenderNode
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RenderNode -> RenderNode
Gsk.RenderNode.RenderNode) Ptr RenderNode
result
    RenderNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RenderNode
node
    RenderNode -> IO RenderNode
forall (m :: * -> *) a. Monad m => a -> m a
return RenderNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Shadow::node_get_n_shadows
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_shadow_node_get_n_shadows" gsk_shadow_node_get_n_shadows :: 
    Ptr Gsk.RenderNode.RenderNode ->        -- node : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    IO Word64

-- | /No description available in the introspection data./
shadowNodeGetNShadows ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gsk.RenderNode.RenderNode
    -> m Word64
shadowNodeGetNShadows :: RenderNode -> m Word64
shadowNodeGetNShadows node :: RenderNode
node = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr RenderNode
node' <- RenderNode -> IO (Ptr RenderNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RenderNode
node
    Word64
result <- Ptr RenderNode -> IO Word64
gsk_shadow_node_get_n_shadows Ptr RenderNode
node'
    RenderNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RenderNode
node
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Shadow::node_new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The node to draw" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shadows"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gsk" , name = "Shadow" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The shadows to apply"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_shadows"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entries in the @shadows array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_shadows"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of entries in the @shadows array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RenderNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_shadow_node_new" gsk_shadow_node_new :: 
    Ptr Gsk.RenderNode.RenderNode ->        -- child : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    Ptr Shadow ->                           -- shadows : TCArray False (-1) 2 (TInterface (Name {namespace = "Gsk", name = "Shadow"}))
    Word64 ->                               -- n_shadows : TBasicType TUInt64
    IO (Ptr Gsk.RenderNode.RenderNode)

-- | Creates a t'GI.Gsk.Structs.RenderNode.RenderNode' that will draw a /@child@/ with the given
-- /@shadows@/ below it.
shadowNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gsk.RenderNode.RenderNode
    -- ^ /@child@/: The node to draw
    -> [Shadow]
    -- ^ /@shadows@/: The shadows to apply
    -> m Gsk.RenderNode.RenderNode
    -- ^ __Returns:__ A new t'GI.Gsk.Structs.RenderNode.RenderNode'
shadowNodeNew :: RenderNode -> [Shadow] -> m RenderNode
shadowNodeNew child :: RenderNode
child shadows :: [Shadow]
shadows = IO RenderNode -> m RenderNode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RenderNode -> m RenderNode) -> IO RenderNode -> m RenderNode
forall a b. (a -> b) -> a -> b
$ do
    let nShadows :: Word64
nShadows = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [Shadow] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Shadow]
shadows
    Ptr RenderNode
child' <- RenderNode -> IO (Ptr RenderNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RenderNode
child
    [Ptr Shadow]
shadows' <- (Shadow -> IO (Ptr Shadow)) -> [Shadow] -> IO [Ptr Shadow]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Shadow -> IO (Ptr Shadow)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Shadow]
shadows
    Ptr Shadow
shadows'' <- Int -> [Ptr Shadow] -> IO (Ptr Shadow)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray 48 [Ptr Shadow]
shadows'
    Ptr RenderNode
result <- Ptr RenderNode -> Ptr Shadow -> Word64 -> IO (Ptr RenderNode)
gsk_shadow_node_new Ptr RenderNode
child' Ptr Shadow
shadows'' Word64
nShadows
    Text -> Ptr RenderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "shadowNodeNew" Ptr RenderNode
result
    RenderNode
result' <- ((ManagedPtr RenderNode -> RenderNode)
-> Ptr RenderNode -> IO RenderNode
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RenderNode -> RenderNode
Gsk.RenderNode.RenderNode) Ptr RenderNode
result
    RenderNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RenderNode
child
    (Shadow -> IO ()) -> [Shadow] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Shadow -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Shadow]
shadows
    Ptr Shadow -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Shadow
shadows''
    RenderNode -> IO RenderNode
forall (m :: * -> *) a. Monad m => a -> m a
return RenderNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Shadow::node_peek_shadow
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "i"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "Shadow" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_shadow_node_peek_shadow" gsk_shadow_node_peek_shadow :: 
    Ptr Gsk.RenderNode.RenderNode ->        -- node : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    Word64 ->                               -- i : TBasicType TUInt64
    IO (Ptr Shadow)

-- | /No description available in the introspection data./
shadowNodePeekShadow ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gsk.RenderNode.RenderNode
    -> Word64
    -> m Shadow
shadowNodePeekShadow :: RenderNode -> Word64 -> m Shadow
shadowNodePeekShadow node :: RenderNode
node i :: Word64
i = IO Shadow -> m Shadow
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Shadow -> m Shadow) -> IO Shadow -> m Shadow
forall a b. (a -> b) -> a -> b
$ do
    Ptr RenderNode
node' <- RenderNode -> IO (Ptr RenderNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RenderNode
node
    Ptr Shadow
result <- Ptr RenderNode -> Word64 -> IO (Ptr Shadow)
gsk_shadow_node_peek_shadow Ptr RenderNode
node' Word64
i
    Text -> Ptr Shadow -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "shadowNodePeekShadow" Ptr Shadow
result
    Shadow
result' <- ((ManagedPtr Shadow -> Shadow) -> Ptr Shadow -> IO Shadow
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Shadow -> Shadow
Shadow) Ptr Shadow
result
    RenderNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RenderNode
node
    Shadow -> IO Shadow
forall (m :: * -> *) a. Monad m => a -> m a
return Shadow
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveShadowMethod (t :: Symbol) (o :: *) :: * where
    ResolveShadowMethod l o = O.MethodResolutionFailed l o

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

#endif