{-# 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 a border.

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

module GI.Gsk.Objects.BorderNode
    ( 

-- * Exported types
    BorderNode(..)                          ,
    IsBorderNode                            ,
    toBorderNode                            ,


 -- * 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
-- [getBounds]("GI.Gsk.Objects.RenderNode#g:method:getBounds"), [getColors]("GI.Gsk.Objects.BorderNode#g:method:getColors"), [getNodeType]("GI.Gsk.Objects.RenderNode#g:method:getNodeType"), [getOutline]("GI.Gsk.Objects.BorderNode#g:method:getOutline"), [getWidths]("GI.Gsk.Objects.BorderNode#g:method:getWidths").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveBorderNodeMethod                 ,
#endif

-- ** getColors #method:getColors#

#if defined(ENABLE_OVERLOADING)
    BorderNodeGetColorsMethodInfo           ,
#endif
    borderNodeGetColors                     ,


-- ** getOutline #method:getOutline#

#if defined(ENABLE_OVERLOADING)
    BorderNodeGetOutlineMethodInfo          ,
#endif
    borderNodeGetOutline                    ,


-- ** getWidths #method:getWidths#

#if defined(ENABLE_OVERLOADING)
    BorderNodeGetWidthsMethodInfo           ,
#endif
    borderNodeGetWidths                     ,


-- ** new #method:new#

    borderNodeNew                           ,




    ) 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.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 BorderNode = BorderNode (SP.ManagedPtr BorderNode)
    deriving (BorderNode -> BorderNode -> Bool
(BorderNode -> BorderNode -> Bool)
-> (BorderNode -> BorderNode -> Bool) -> Eq BorderNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BorderNode -> BorderNode -> Bool
$c/= :: BorderNode -> BorderNode -> Bool
== :: BorderNode -> BorderNode -> Bool
$c== :: BorderNode -> BorderNode -> Bool
Eq)

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

foreign import ccall "gsk_border_node_get_type"
    c_gsk_border_node_get_type :: IO B.Types.GType

instance B.Types.TypedObject BorderNode where
    glibType :: IO GType
glibType = IO GType
c_gsk_border_node_get_type

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

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

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

--- XXX Missing getter and/or setter, so no GValue instance could be generated.
#if defined(ENABLE_OVERLOADING)
type family ResolveBorderNodeMethod (t :: Symbol) (o :: *) :: * where
    ResolveBorderNodeMethod "draw" o = Gsk.RenderNode.RenderNodeDrawMethodInfo
    ResolveBorderNodeMethod "ref" o = Gsk.RenderNode.RenderNodeRefMethodInfo
    ResolveBorderNodeMethod "serialize" o = Gsk.RenderNode.RenderNodeSerializeMethodInfo
    ResolveBorderNodeMethod "unref" o = Gsk.RenderNode.RenderNodeUnrefMethodInfo
    ResolveBorderNodeMethod "writeToFile" o = Gsk.RenderNode.RenderNodeWriteToFileMethodInfo
    ResolveBorderNodeMethod "getBounds" o = Gsk.RenderNode.RenderNodeGetBoundsMethodInfo
    ResolveBorderNodeMethod "getColors" o = BorderNodeGetColorsMethodInfo
    ResolveBorderNodeMethod "getNodeType" o = Gsk.RenderNode.RenderNodeGetNodeTypeMethodInfo
    ResolveBorderNodeMethod "getOutline" o = BorderNodeGetOutlineMethodInfo
    ResolveBorderNodeMethod "getWidths" o = BorderNodeGetWidthsMethodInfo
    ResolveBorderNodeMethod l o = O.MethodResolutionFailed l o

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

#endif

instance (info ~ ResolveBorderNodeMethod t BorderNode, O.OverloadedMethodInfo info BorderNode) => OL.IsLabel t (O.MethodProxy info BorderNode) 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 BorderNode where
    boxedPtrCopy :: BorderNode -> IO BorderNode
boxedPtrCopy = BorderNode -> IO BorderNode
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: BorderNode -> IO ()
boxedPtrFree = \BorderNode
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- method BorderNode::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "outline"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a `GskRoundedRect` describing the outline of the border"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "border_width"
--           , argType = TCArray False 4 (-1) (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the stroke width of the border on\n    the top, right, bottom and left side respectively."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "border_color"
--           , argType =
--               TCArray
--                 False
--                 4
--                 (-1)
--                 (TInterface Name { namespace = "Gdk" , name = "RGBA" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the color used on the top, right,\n    bottom and left side."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "BorderNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_border_node_new" gsk_border_node_new :: 
    Ptr Gsk.RoundedRect.RoundedRect ->      -- outline : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr CFloat ->                           -- border_width : TCArray False 4 (-1) (TBasicType TFloat)
    Ptr Gdk.RGBA.RGBA ->                    -- border_color : TCArray False 4 (-1) (TInterface (Name {namespace = "Gdk", name = "RGBA"}))
    IO (Ptr BorderNode)

-- | Creates a @GskRenderNode@ that will stroke a border rectangle inside the
-- given /@outline@/.
-- 
-- The 4 sides of the border can have different widths and colors.
borderNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gsk.RoundedRect.RoundedRect
    -- ^ /@outline@/: a @GskRoundedRect@ describing the outline of the border
    -> [Float]
    -- ^ /@borderWidth@/: the stroke width of the border on
    --     the top, right, bottom and left side respectively.
    -> [Gdk.RGBA.RGBA]
    -- ^ /@borderColor@/: the color used on the top, right,
    --     bottom and left side.
    -> m BorderNode
    -- ^ __Returns:__ A new @GskRenderNode@
borderNodeNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RoundedRect -> [Float] -> [RGBA] -> m BorderNode
borderNodeNew RoundedRect
outline [Float]
borderWidth [RGBA]
borderColor = IO BorderNode -> m BorderNode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BorderNode -> m BorderNode) -> IO BorderNode -> m BorderNode
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 CFloat
borderWidth' <- ((Float -> CFloat) -> [Float] -> IO (Ptr CFloat)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Float]
borderWidth
    [Ptr RGBA]
borderColor' <- (RGBA -> IO (Ptr RGBA)) -> [RGBA] -> IO [Ptr RGBA]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [RGBA]
borderColor
    Ptr RGBA
borderColor'' <- Int -> [Ptr RGBA] -> IO (Ptr RGBA)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr RGBA]
borderColor'
    Ptr BorderNode
result <- Ptr RoundedRect -> Ptr CFloat -> Ptr RGBA -> IO (Ptr BorderNode)
gsk_border_node_new Ptr RoundedRect
outline' Ptr CFloat
borderWidth' Ptr RGBA
borderColor''
    Text -> Ptr BorderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"borderNodeNew" Ptr BorderNode
result
    BorderNode
result' <- ((ManagedPtr BorderNode -> BorderNode)
-> Ptr BorderNode -> IO BorderNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr BorderNode -> BorderNode
BorderNode) Ptr BorderNode
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
outline
    (RGBA -> IO ()) -> [RGBA] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [RGBA]
borderColor
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
borderWidth'
    Ptr RGBA -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr RGBA
borderColor''
    BorderNode -> IO BorderNode
forall (m :: * -> *) a. Monad m => a -> m a
return BorderNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BorderNode::get_colors
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "BorderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode` for a border"
--                 , 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_border_node_get_colors" gsk_border_node_get_colors :: 
    Ptr BorderNode ->                       -- node : TInterface (Name {namespace = "Gsk", name = "BorderNode"})
    IO (Ptr Gdk.RGBA.RGBA)

-- | Retrieves the colors of the border.
borderNodeGetColors ::
    (B.CallStack.HasCallStack, MonadIO m, IsBorderNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for a border
    -> m Gdk.RGBA.RGBA
    -- ^ __Returns:__ an array of 4 @GdkRGBA@ structs
    --     for the top, right, bottom and left color of the border
borderNodeGetColors :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBorderNode a) =>
a -> m RGBA
borderNodeGetColors a
node = 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
$ do
    Ptr BorderNode
node' <- a -> IO (Ptr BorderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RGBA
result <- Ptr BorderNode -> IO (Ptr RGBA)
gsk_border_node_get_colors Ptr BorderNode
node'
    Text -> Ptr RGBA -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"borderNodeGetColors" 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 (m :: * -> *) a. Monad m => a -> m a
return RGBA
result'

#if defined(ENABLE_OVERLOADING)
data BorderNodeGetColorsMethodInfo
instance (signature ~ (m Gdk.RGBA.RGBA), MonadIO m, IsBorderNode a) => O.OverloadedMethod BorderNodeGetColorsMethodInfo a signature where
    overloadedMethod = borderNodeGetColors

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


#endif

-- method BorderNode::get_outline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "BorderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode` for a border"
--                 , 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_border_node_get_outline" gsk_border_node_get_outline :: 
    Ptr BorderNode ->                       -- node : TInterface (Name {namespace = "Gsk", name = "BorderNode"})
    IO (Ptr Gsk.RoundedRect.RoundedRect)

-- | Retrieves the outline of the border.
borderNodeGetOutline ::
    (B.CallStack.HasCallStack, MonadIO m, IsBorderNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for a border
    -> m Gsk.RoundedRect.RoundedRect
    -- ^ __Returns:__ the outline of the border
borderNodeGetOutline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBorderNode a) =>
a -> m RoundedRect
borderNodeGetOutline a
node = IO RoundedRect -> m RoundedRect
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 BorderNode
node' <- a -> IO (Ptr BorderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RoundedRect
result <- Ptr BorderNode -> IO (Ptr RoundedRect)
gsk_border_node_get_outline Ptr BorderNode
node'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"borderNodeGetOutline" 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 (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
data BorderNodeGetOutlineMethodInfo
instance (signature ~ (m Gsk.RoundedRect.RoundedRect), MonadIO m, IsBorderNode a) => O.OverloadedMethod BorderNodeGetOutlineMethodInfo a signature where
    overloadedMethod = borderNodeGetOutline

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


#endif

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

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

-- | Retrieves the stroke widths of the border.
borderNodeGetWidths ::
    (B.CallStack.HasCallStack, MonadIO m, IsBorderNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ for a border
    -> m [Float]
    -- ^ __Returns:__ an array of 4 floats
    --   for the top, right, bottom and left stroke width of the border,
    --   respectively
borderNodeGetWidths :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBorderNode a) =>
a -> m [Float]
borderNodeGetWidths a
node = 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
$ do
    Ptr BorderNode
node' <- a -> IO (Ptr BorderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr CFloat
result <- Ptr BorderNode -> IO (Ptr CFloat)
gsk_border_node_get_widths Ptr BorderNode
node'
    Text -> Ptr CFloat -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"borderNodeGetWidths" Ptr CFloat
result
    [Float]
result' <- ((CFloat -> Float) -> Integer -> Ptr CFloat -> IO [Float]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
4) Ptr CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    [Float] -> IO [Float]
forall (m :: * -> *) a. Monad m => a -> m a
return [Float]
result'

#if defined(ENABLE_OVERLOADING)
data BorderNodeGetWidthsMethodInfo
instance (signature ~ (m [Float]), MonadIO m, IsBorderNode a) => O.OverloadedMethod BorderNodeGetWidthsMethodInfo a signature where
    overloadedMethod = borderNodeGetWidths

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


#endif