{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A render node applying a rounded rectangle clip to its single child.

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

module GI.Gsk.Objects.RoundedClipNode
    ( 

-- * Exported types
    RoundedClipNode(..)                     ,
    IsRoundedClipNode                       ,
    toRoundedClipNode                       ,


 -- * 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"), [getChild]("GI.Gsk.Objects.RoundedClipNode#g:method:getChild"), [getClip]("GI.Gsk.Objects.RoundedClipNode#g:method:getClip"), [getNodeType]("GI.Gsk.Objects.RenderNode#g:method:getNodeType").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRoundedClipNodeMethod            ,
#endif

-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    RoundedClipNodeGetChildMethodInfo       ,
#endif
    roundedClipNodeGetChild                 ,


-- ** getClip #method:getClip#

#if defined(ENABLE_OVERLOADING)
    RoundedClipNodeGetClipMethodInfo        ,
#endif
    roundedClipNodeGetClip                  ,


-- ** new #method:new#

    roundedClipNodeNew                      ,




    ) 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 {-# SOURCE #-} qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import {-# SOURCE #-} qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect

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

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

foreign import ccall "gsk_rounded_clip_node_get_type"
    c_gsk_rounded_clip_node_get_type :: IO B.Types.GType

instance B.Types.TypedObject RoundedClipNode where
    glibType :: IO GType
glibType = IO GType
c_gsk_rounded_clip_node_get_type

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

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

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

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

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

#endif

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


-- method RoundedClipNode::new
-- method type : Constructor
-- 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 = "clip"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The clip to apply" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gsk" , name = "RoundedClipNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_rounded_clip_node_new" gsk_rounded_clip_node_new :: 
    Ptr Gsk.RenderNode.RenderNode ->        -- child : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    Ptr Gsk.RoundedRect.RoundedRect ->      -- clip : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    IO (Ptr RoundedClipNode)

-- | Creates a @GskRenderNode@ that will clip the /@child@/ to the area
-- given by /@clip@/.
roundedClipNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gsk.RenderNode.IsRenderNode a) =>
    a
    -- ^ /@child@/: The node to draw
    -> Gsk.RoundedRect.RoundedRect
    -- ^ /@clip@/: The clip to apply
    -> m RoundedClipNode
    -- ^ __Returns:__ A new @GskRenderNode@
roundedClipNodeNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRenderNode a) =>
a -> RoundedRect -> m RoundedClipNode
roundedClipNodeNew a
child RoundedRect
clip = IO RoundedClipNode -> m RoundedClipNode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedClipNode -> m RoundedClipNode)
-> IO RoundedClipNode -> m RoundedClipNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr RenderNode
child' <- a -> IO (Ptr RenderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
child
    Ptr RoundedRect
clip' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
clip
    Ptr RoundedClipNode
result <- Ptr RenderNode -> Ptr RoundedRect -> IO (Ptr RoundedClipNode)
gsk_rounded_clip_node_new Ptr RenderNode
child' Ptr RoundedRect
clip'
    Text -> Ptr RoundedClipNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedClipNodeNew" Ptr RoundedClipNode
result
    RoundedClipNode
result' <- ((ManagedPtr RoundedClipNode -> RoundedClipNode)
-> Ptr RoundedClipNode -> IO RoundedClipNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedClipNode -> RoundedClipNode
RoundedClipNode) Ptr RoundedClipNode
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
child
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
clip
    RoundedClipNode -> IO RoundedClipNode
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedClipNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method RoundedClipNode::get_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedClipNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a rounded clip `GskRenderNode`"
--                 , 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_rounded_clip_node_get_child" gsk_rounded_clip_node_get_child :: 
    Ptr RoundedClipNode ->                  -- node : TInterface (Name {namespace = "Gsk", name = "RoundedClipNode"})
    IO (Ptr Gsk.RenderNode.RenderNode)

-- | Gets the child node that is getting clipped by the given /@node@/.
roundedClipNodeGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsRoundedClipNode a) =>
    a
    -- ^ /@node@/: a rounded clip @GskRenderNode@
    -> m Gsk.RenderNode.RenderNode
    -- ^ __Returns:__ The child that is getting clipped
roundedClipNodeGetChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRoundedClipNode a) =>
a -> m RenderNode
roundedClipNodeGetChild a
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 RoundedClipNode
node' <- a -> IO (Ptr RoundedClipNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RenderNode
result <- Ptr RoundedClipNode -> IO (Ptr RenderNode)
gsk_rounded_clip_node_get_child Ptr RoundedClipNode
node'
    Text -> Ptr RenderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedClipNodeGetChild" Ptr RenderNode
result
    RenderNode
result' <- ((ManagedPtr RenderNode -> RenderNode)
-> Ptr RenderNode -> IO RenderNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RenderNode -> RenderNode
Gsk.RenderNode.RenderNode) Ptr RenderNode
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    RenderNode -> IO RenderNode
forall (m :: * -> *) a. Monad m => a -> m a
return RenderNode
result'

#if defined(ENABLE_OVERLOADING)
data RoundedClipNodeGetChildMethodInfo
instance (signature ~ (m Gsk.RenderNode.RenderNode), MonadIO m, IsRoundedClipNode a) => O.OverloadedMethod RoundedClipNodeGetChildMethodInfo a signature where
    overloadedMethod = roundedClipNodeGetChild

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


#endif

-- method RoundedClipNode::get_clip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedClipNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a rounded clip `GskRenderNode`"
--                 , 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_rounded_clip_node_get_clip" gsk_rounded_clip_node_get_clip :: 
    Ptr RoundedClipNode ->                  -- node : TInterface (Name {namespace = "Gsk", name = "RoundedClipNode"})
    IO (Ptr Gsk.RoundedRect.RoundedRect)

-- | Retrieves the rounded rectangle used to clip the contents of the /@node@/.
roundedClipNodeGetClip ::
    (B.CallStack.HasCallStack, MonadIO m, IsRoundedClipNode a) =>
    a
    -- ^ /@node@/: a rounded clip @GskRenderNode@
    -> m Gsk.RoundedRect.RoundedRect
    -- ^ __Returns:__ a rounded rectangle
roundedClipNodeGetClip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRoundedClipNode a) =>
a -> m RoundedRect
roundedClipNodeGetClip 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 RoundedClipNode
node' <- a -> IO (Ptr RoundedClipNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RoundedRect
result <- Ptr RoundedClipNode -> IO (Ptr RoundedRect)
gsk_rounded_clip_node_get_clip Ptr RoundedClipNode
node'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"roundedClipNodeGetClip" 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 RoundedClipNodeGetClipMethodInfo
instance (signature ~ (m Gsk.RoundedRect.RoundedRect), MonadIO m, IsRoundedClipNode a) => O.OverloadedMethod RoundedClipNodeGetClipMethodInfo a signature where
    overloadedMethod = roundedClipNodeGetClip

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


#endif