{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GskPath@ describes lines and curves that are more complex
-- than simple rectangles.
-- 
-- Paths can used for rendering (filling or stroking) and for animations
-- (e.g. as trajectories).
-- 
-- @GskPath@ is an immutable, opaque, reference-counted struct.
-- After creation, you cannot change the types it represents. Instead,
-- new @GskPath@ objects have to be created. The [struct/@gsk@/.PathBuilder]
-- structure is meant to help in this endeavor.
-- 
-- Conceptually, a path consists of zero or more contours (continuous, connected
-- curves), each of which may or may not be closed. Contours are typically
-- constructed from Bézier segments.
-- 
-- \<picture>
--   \<source srcset=\"path-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img alt=\"A Path\" src=\"path-light.png\">
-- \<\/picture>
-- 
-- /Since: 4.14/

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

module GI.Gsk.Structs.Path
    ( 

-- * Exported types
    Path(..)                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [foreach]("GI.Gsk.Structs.Path#g:method:foreach"), [inFill]("GI.Gsk.Structs.Path#g:method:inFill"), [isClosed]("GI.Gsk.Structs.Path#g:method:isClosed"), [isEmpty]("GI.Gsk.Structs.Path#g:method:isEmpty"), [print]("GI.Gsk.Structs.Path#g:method:print"), [ref]("GI.Gsk.Structs.Path#g:method:ref"), [toCairo]("GI.Gsk.Structs.Path#g:method:toCairo"), [toString]("GI.Gsk.Structs.Path#g:method:toString"), [unref]("GI.Gsk.Structs.Path#g:method:unref").
-- 
-- ==== Getters
-- [getBounds]("GI.Gsk.Structs.Path#g:method:getBounds"), [getStrokeBounds]("GI.Gsk.Structs.Path#g:method:getStrokeBounds").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolvePathMethod                       ,
#endif

-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    PathForeachMethodInfo                   ,
#endif
    pathForeach                             ,


-- ** getBounds #method:getBounds#

#if defined(ENABLE_OVERLOADING)
    PathGetBoundsMethodInfo                 ,
#endif
    pathGetBounds                           ,


-- ** getStrokeBounds #method:getStrokeBounds#

#if defined(ENABLE_OVERLOADING)
    PathGetStrokeBoundsMethodInfo           ,
#endif
    pathGetStrokeBounds                     ,


-- ** inFill #method:inFill#

#if defined(ENABLE_OVERLOADING)
    PathInFillMethodInfo                    ,
#endif
    pathInFill                              ,


-- ** isClosed #method:isClosed#

#if defined(ENABLE_OVERLOADING)
    PathIsClosedMethodInfo                  ,
#endif
    pathIsClosed                            ,


-- ** isEmpty #method:isEmpty#

#if defined(ENABLE_OVERLOADING)
    PathIsEmptyMethodInfo                   ,
#endif
    pathIsEmpty                             ,


-- ** parse #method:parse#

    pathParse                               ,


-- ** print #method:print#

#if defined(ENABLE_OVERLOADING)
    PathPrintMethodInfo                     ,
#endif
    pathPrint                               ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    PathRefMethodInfo                       ,
#endif
    pathRef                                 ,


-- ** toCairo #method:toCairo#

#if defined(ENABLE_OVERLOADING)
    PathToCairoMethodInfo                   ,
#endif
    pathToCairo                             ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    PathToStringMethodInfo                  ,
#endif
    pathToString                            ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    PathUnrefMethodInfo                     ,
#endif
    pathUnref                               ,




    ) 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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Gsk.Callbacks as Gsk.Callbacks
import {-# SOURCE #-} qualified GI.Gsk.Enums as Gsk.Enums
import {-# SOURCE #-} qualified GI.Gsk.Flags as Gsk.Flags
import {-# SOURCE #-} qualified GI.Gsk.Structs.Stroke as Gsk.Stroke

#else
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Gsk.Callbacks as Gsk.Callbacks
import {-# SOURCE #-} qualified GI.Gsk.Enums as Gsk.Enums
import {-# SOURCE #-} qualified GI.Gsk.Flags as Gsk.Flags
import {-# SOURCE #-} qualified GI.Gsk.Structs.Stroke as Gsk.Stroke

#endif

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

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

foreign import ccall "gsk_path_get_type" c_gsk_path_get_type :: 
    IO GType

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

instance B.Types.TypedObject Path where
    glibType :: IO GType
glibType = IO GType
c_gsk_path_get_type

instance B.Types.GBoxed Path

-- | Convert 'Path' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Path) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gsk_path_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Path -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Path
P.Nothing = Ptr GValue -> Ptr Path -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Path
forall a. Ptr a
FP.nullPtr :: FP.Ptr Path)
    gvalueSet_ Ptr GValue
gv (P.Just Path
obj) = Path -> (Ptr Path -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Path
obj (Ptr GValue -> Ptr Path -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Path)
gvalueGet_ Ptr GValue
gv = do
        Ptr Path
ptr <- Ptr GValue -> IO (Ptr Path)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Path)
        if Ptr Path
ptr Ptr Path -> Ptr Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Path
forall a. Ptr a
FP.nullPtr
        then Path -> Maybe Path
forall a. a -> Maybe a
P.Just (Path -> Maybe Path) -> IO Path -> IO (Maybe Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Path -> Path) -> Ptr Path -> IO Path
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Path -> Path
Path Ptr Path
ptr
        else Maybe Path -> IO (Maybe Path)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Path
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Path
type instance O.AttributeList Path = PathAttributeList
type PathAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method Path::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathForeachFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "flags to pass to the foreach function. See [flags@Gsk.PathForeachFlags]\n  for details about flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathForeachFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to call for operations"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_foreach" gsk_path_foreach :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gsk", name = "PathForeachFlags"})
    FunPtr Gsk.Callbacks.C_PathForeachFunc -> -- func : TInterface (Name {namespace = "Gsk", name = "PathForeachFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Calls /@func@/ for every operation of the path.
-- 
-- Note that this may only approximate /@self@/, because paths can contain
-- optimizations for various specialized contours, and depending on the
-- /@flags@/, the path may be decomposed into simpler curves than the ones
-- that it contained originally.
-- 
-- This function serves two purposes:
-- 
-- * When the /@flags@/ allow everything, it provides access to the raw,
-- unmodified data of the path.
-- * When the /@flags@/ disallow certain operations, it provides
-- an approximation of the path using just the allowed operations.
-- 
-- 
-- /Since: 4.14/
pathForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> [Gsk.Flags.PathForeachFlags]
    -- ^ /@flags@/: flags to pass to the foreach function. See [flags/@gsk@/.PathForeachFlags]
    --   for details about flags
    -> Gsk.Callbacks.PathForeachFunc
    -- ^ /@func@/: the function to call for operations
    -> m Bool
    -- ^ __Returns:__ @FALSE@ if /@func@/ returned FALSE@, @TRUE\` otherwise.
pathForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Path -> [PathForeachFlags] -> PathForeachFunc -> m Bool
pathForeach Path
self [PathForeachFlags]
flags PathForeachFunc
func = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    let flags' :: CUInt
flags' = [PathForeachFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PathForeachFlags]
flags
    FunPtr C_PathForeachFunc
func' <- C_PathForeachFunc -> IO (FunPtr C_PathForeachFunc)
Gsk.Callbacks.mk_PathForeachFunc (Maybe (Ptr (FunPtr C_PathForeachFunc))
-> PathForeachFunc_WithClosures -> C_PathForeachFunc
Gsk.Callbacks.wrap_PathForeachFunc Maybe (Ptr (FunPtr C_PathForeachFunc))
forall a. Maybe a
Nothing (PathForeachFunc -> PathForeachFunc_WithClosures
Gsk.Callbacks.drop_closures_PathForeachFunc PathForeachFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Path -> CUInt -> FunPtr C_PathForeachFunc -> Ptr () -> IO CInt
gsk_path_foreach Ptr Path
self' CUInt
flags' FunPtr C_PathForeachFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_PathForeachFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PathForeachFunc
func'
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PathForeachMethodInfo
instance (signature ~ ([Gsk.Flags.PathForeachFlags] -> Gsk.Callbacks.PathForeachFunc -> m Bool), MonadIO m) => O.OverloadedMethod PathForeachMethodInfo Path signature where
    overloadedMethod = pathForeach

instance O.OverloadedMethodInfo PathForeachMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathForeach"
        })


#endif

-- method Path::get_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bounds of the given path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_get_bounds" gsk_path_get_bounds :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO CInt

-- | Computes the bounds of the given path.
-- 
-- The returned bounds may be larger than necessary, because this
-- function aims to be fast, not accurate. The bounds are guaranteed
-- to contain the path.
-- 
-- It is possible that the returned rectangle has 0 width and\/or height.
-- This can happen when the path only describes a point or an
-- axis-aligned line.
-- 
-- If the path is empty, @FALSE@ is returned and /@bounds@/ are set to
-- 'GI.Graphene.Functions.rectZero'. This is different from the case where the path
-- is a single point at the origin, where the /@bounds@/ will also be set to
-- the zero rectangle but @TRUE@ will be returned.
-- 
-- /Since: 4.14/
pathGetBounds ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> m ((Bool, Graphene.Rect.Rect))
    -- ^ __Returns:__ @TRUE@ if the path has bounds, @FALSE@ if the path is known
    --   to be empty and have no bounds.
pathGetBounds :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Path -> m (Bool, Rect)
pathGetBounds Path
self = IO (Bool, Rect) -> m (Bool, Rect)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Rect) -> m (Bool, Rect))
-> IO (Bool, Rect) -> m (Bool, Rect)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    Ptr Rect
bounds <- Int -> IO (Ptr Rect)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Graphene.Rect.Rect)
    CInt
result <- Ptr Path -> Ptr Rect -> IO CInt
gsk_path_get_bounds Ptr Path
self' Ptr Rect
bounds
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rect
bounds' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Graphene.Rect.Rect) Ptr Rect
bounds
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    (Bool, Rect) -> IO (Bool, Rect)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Rect
bounds')

#if defined(ENABLE_OVERLOADING)
data PathGetBoundsMethodInfo
instance (signature ~ (m ((Bool, Graphene.Rect.Rect))), MonadIO m) => O.OverloadedMethod PathGetBoundsMethodInfo Path signature where
    overloadedMethod = pathGetBounds

instance O.OverloadedMethodInfo PathGetBoundsMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathGetBounds",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathGetBounds"
        })


#endif

-- XXX Could not generate method Path::get_closest_point
-- Not implemented: Don't know how to allocate "result" of type TInterface (Name {namespace = "Gsk", name = "PathPoint"})
-- XXX Could not generate method Path::get_end_point
-- Not implemented: Don't know how to allocate "result" of type TInterface (Name {namespace = "Gsk", name = "PathPoint"})
-- XXX Could not generate method Path::get_start_point
-- Not implemented: Don't know how to allocate "result" of type TInterface (Name {namespace = "Gsk", name = "PathPoint"})
-- method Path::get_stroke_bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stroke"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "stroke parameters" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bounds to fill in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_get_stroke_bounds" gsk_path_get_stroke_bounds :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    Ptr Gsk.Stroke.Stroke ->                -- stroke : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO CInt

-- | Computes the bounds for stroking the given path with the
-- parameters in /@stroke@/.
-- 
-- The returned bounds may be larger than necessary, because this
-- function aims to be fast, not accurate. The bounds are guaranteed
-- to contain the area affected by the stroke, including protrusions
-- like miters.
-- 
-- /Since: 4.14/
pathGetStrokeBounds ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @/GtkPath/@
    -> Gsk.Stroke.Stroke
    -- ^ /@stroke@/: stroke parameters
    -> m ((Bool, Graphene.Rect.Rect))
    -- ^ __Returns:__ @TRUE@ if the path has bounds, @FALSE@ if the path is known
    --   to be empty and have no bounds.
pathGetStrokeBounds :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Path -> Stroke -> m (Bool, Rect)
pathGetStrokeBounds Path
self Stroke
stroke = IO (Bool, Rect) -> m (Bool, Rect)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Rect) -> m (Bool, Rect))
-> IO (Bool, Rect) -> m (Bool, Rect)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    Ptr Stroke
stroke' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
stroke
    Ptr Rect
bounds <- Int -> IO (Ptr Rect)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Graphene.Rect.Rect)
    CInt
result <- Ptr Path -> Ptr Stroke -> Ptr Rect -> IO CInt
gsk_path_get_stroke_bounds Ptr Path
self' Ptr Stroke
stroke' Ptr Rect
bounds
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rect
bounds' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Graphene.Rect.Rect) Ptr Rect
bounds
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
stroke
    (Bool, Rect) -> IO (Bool, Rect)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Rect
bounds')

#if defined(ENABLE_OVERLOADING)
data PathGetStrokeBoundsMethodInfo
instance (signature ~ (Gsk.Stroke.Stroke -> m ((Bool, Graphene.Rect.Rect))), MonadIO m) => O.OverloadedMethod PathGetStrokeBoundsMethodInfo Path signature where
    overloadedMethod = pathGetStrokeBounds

instance O.OverloadedMethodInfo PathGetStrokeBoundsMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathGetStrokeBounds",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathGetStrokeBounds"
        })


#endif

-- method Path::in_fill
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the point to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fill_rule"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "FillRule" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the fill rule to follow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_in_fill" gsk_path_in_fill :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    Ptr Graphene.Point.Point ->             -- point : TInterface (Name {namespace = "Graphene", name = "Point"})
    CUInt ->                                -- fill_rule : TInterface (Name {namespace = "Gsk", name = "FillRule"})
    IO CInt

-- | Returns whether the given point is inside the area
-- that would be affected if the path was filled according
-- to /@fillRule@/.
-- 
-- Note that this function assumes that filling a contour
-- implicitly closes it.
-- 
-- /Since: 4.14/
pathInFill ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> Graphene.Point.Point
    -- ^ /@point@/: the point to test
    -> Gsk.Enums.FillRule
    -- ^ /@fillRule@/: the fill rule to follow
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@point@/ is inside
pathInFill :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Path -> Point -> FillRule -> m Bool
pathInFill Path
self Point
point FillRule
fillRule = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    Ptr Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    let fillRule' :: CUInt
fillRule' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (FillRule -> Int) -> FillRule -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillRule -> Int
forall a. Enum a => a -> Int
fromEnum) FillRule
fillRule
    CInt
result <- Ptr Path -> Ptr Point -> CUInt -> IO CInt
gsk_path_in_fill Ptr Path
self' Ptr Point
point' CUInt
fillRule'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PathInFillMethodInfo
instance (signature ~ (Graphene.Point.Point -> Gsk.Enums.FillRule -> m Bool), MonadIO m) => O.OverloadedMethod PathInFillMethodInfo Path signature where
    overloadedMethod = pathInFill

instance O.OverloadedMethodInfo PathInFillMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathInFill",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathInFill"
        })


#endif

-- method Path::is_closed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_is_closed" gsk_path_is_closed :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    IO CInt

-- | Returns if the path represents a single closed
-- contour.
-- 
-- /Since: 4.14/
pathIsClosed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the path is closed
pathIsClosed :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Path -> m Bool
pathIsClosed Path
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    CInt
result <- Ptr Path -> IO CInt
gsk_path_is_closed Ptr Path
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PathIsClosedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod PathIsClosedMethodInfo Path signature where
    overloadedMethod = pathIsClosed

instance O.OverloadedMethodInfo PathIsClosedMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathIsClosed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathIsClosed"
        })


#endif

-- method Path::is_empty
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_is_empty" gsk_path_is_empty :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    IO CInt

-- | Checks if the path is empty, i.e. contains no lines or curves.
-- 
-- /Since: 4.14/
pathIsEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the path is empty
pathIsEmpty :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Path -> m Bool
pathIsEmpty Path
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    CInt
result <- Ptr Path -> IO CInt
gsk_path_is_empty Ptr Path
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PathIsEmptyMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod PathIsEmptyMethodInfo Path signature where
    overloadedMethod = pathIsEmpty

instance O.OverloadedMethodInfo PathIsEmptyMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathIsEmpty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathIsEmpty"
        })


#endif

-- method Path::print
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "string"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The string to print into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_print" gsk_path_print :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    Ptr GLib.String.String ->               -- string : TInterface (Name {namespace = "GLib", name = "String"})
    IO ()

-- | Converts /@self@/ into a human-readable string representation suitable
-- for printing.
-- 
-- The string is compatible with (a superset of)
-- <https://www.w3.org/TR/SVG11/paths.html#PathData SVG path syntax>,
-- see [func/@gsk@/.Path.parse] for a summary of the syntax.
-- 
-- /Since: 4.14/
pathPrint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> GLib.String.String
    -- ^ /@string@/: The string to print into
    -> m ()
pathPrint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Path -> String -> m ()
pathPrint Path
self String
string = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    Ptr String
string' <- String -> IO (Ptr String)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr String
string
    Ptr Path -> Ptr String -> IO ()
gsk_path_print Ptr Path
self' Ptr String
string'
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    String -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr String
string
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathPrintMethodInfo
instance (signature ~ (GLib.String.String -> m ()), MonadIO m) => O.OverloadedMethod PathPrintMethodInfo Path signature where
    overloadedMethod = pathPrint

instance O.OverloadedMethodInfo PathPrintMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathPrint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathPrint"
        })


#endif

-- method Path::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "Path" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_ref" gsk_path_ref :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    IO (Ptr Path)

-- | Increases the reference count of a @GskPath@ by one.
-- 
-- /Since: 4.14/
pathRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> m Path
    -- ^ __Returns:__ the passed in @GskPath@.
pathRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Path -> m Path
pathRef Path
self = IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Path -> m Path) -> IO Path -> m Path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    Ptr Path
result <- Ptr Path -> IO (Ptr Path)
gsk_path_ref Ptr Path
self'
    Text -> Ptr Path -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathRef" Ptr Path
result
    Path
result' <- ((ManagedPtr Path -> Path) -> Ptr Path -> IO Path
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Path -> Path
Path) Ptr Path
result
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    Path -> IO Path
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Path
result'

#if defined(ENABLE_OVERLOADING)
data PathRefMethodInfo
instance (signature ~ (m Path), MonadIO m) => O.OverloadedMethod PathRefMethodInfo Path signature where
    overloadedMethod = pathRef

instance O.OverloadedMethodInfo PathRefMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathRef"
        })


#endif

-- method Path::to_cairo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cr"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cairo context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_to_cairo" gsk_path_to_cairo :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    IO ()

-- | Appends the given /@path@/ to the given cairo context for drawing
-- with Cairo.
-- 
-- This may cause some suboptimal conversions to be performed as
-- Cairo does not support all features of @GskPath@.
-- 
-- This function does not clear the existing Cairo path. Call
-- @/cairo_new_path()/@ if you want this.
-- 
-- /Since: 4.14/
pathToCairo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> Cairo.Context.Context
    -- ^ /@cr@/: a cairo context
    -> m ()
pathToCairo :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Path -> Context -> m ()
pathToCairo Path
self Context
cr = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr Path -> Ptr Context -> IO ()
gsk_path_to_cairo Ptr Path
self' Ptr Context
cr'
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathToCairoMethodInfo
instance (signature ~ (Cairo.Context.Context -> m ()), MonadIO m) => O.OverloadedMethod PathToCairoMethodInfo Path signature where
    overloadedMethod = pathToCairo

instance O.OverloadedMethodInfo PathToCairoMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathToCairo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathToCairo"
        })


#endif

-- method Path::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_to_string" gsk_path_to_string :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    IO CString

-- | Converts the path into a string that is suitable for printing.
-- 
-- You can use this function in a debugger to get a quick overview
-- of the path.
-- 
-- This is a wrapper around 'GI.Gsk.Structs.Path.pathPrint', see that function
-- for details.
-- 
-- /Since: 4.14/
pathToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> m T.Text
    -- ^ __Returns:__ A new string for /@self@/
pathToString :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Path -> m Text
pathToString Path
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    CString
result <- Ptr Path -> IO CString
gsk_path_to_string Ptr Path
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PathToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod PathToStringMethodInfo Path signature where
    overloadedMethod = pathToString

instance O.OverloadedMethodInfo PathToStringMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathToString"
        })


#endif

-- method Path::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPath`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_unref" gsk_path_unref :: 
    Ptr Path ->                             -- self : TInterface (Name {namespace = "Gsk", name = "Path"})
    IO ()

-- | Decreases the reference count of a @GskPath@ by one.
-- 
-- If the resulting reference count is zero, frees the path.
-- 
-- /Since: 4.14/
pathUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Path
    -- ^ /@self@/: a @GskPath@
    -> m ()
pathUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Path -> m ()
pathUnref Path
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
self' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
self
    Ptr Path -> IO ()
gsk_path_unref Ptr Path
self'
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PathUnrefMethodInfo Path signature where
    overloadedMethod = pathUnref

instance O.OverloadedMethodInfo PathUnrefMethodInfo Path where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.Path.pathUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-Path.html#v:pathUnref"
        })


#endif

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

foreign import ccall "gsk_path_parse" gsk_path_parse :: 
    CString ->                              -- string : TBasicType TUTF8
    IO (Ptr Path)

-- | This is a convenience function that constructs a @GskPath@
-- from a serialized form.
-- 
-- The string is expected to be in (a superset of)
-- <https://www.w3.org/TR/SVG11/paths.html#PathData SVG path syntax>,
-- as e.g. produced by 'GI.Gsk.Structs.Path.pathToString'.
-- 
-- A high-level summary of the syntax:
-- 
-- * @M x y@ Move to @(x, y)@
-- * @L x y@ Add a line from the current point to @(x, y)@
-- * @Q x1 y1 x2 y2@ Add a quadratic Bézier from the current point to @(x2, y2)@, with control point @(x1, y1)@
-- * @C x1 y1 x2 y2 x3 y3@ Add a cubic Bézier from the current point to @(x3, y3)@, with control points @(x1, y1)@ and @(x2, y2)@
-- * @Z@ Close the contour by drawing a line back to the start point
-- * @H x@ Add a horizontal line from the current point to the given x value
-- * @V y@ Add a vertical line from the current point to the given y value
-- * @T x2 y2@ Add a quadratic Bézier, using the reflection of the previous segments\' control point as control point
-- * @S x2 y2 x3 y3@ Add a cubic Bézier, using the reflection of the previous segments\' second control point as first control point
-- * @A rx ry r l s x y@ Add an elliptical arc from the current point to @(x, y)@ with radii rx and ry. See the SVG documentation for how the other parameters influence the arc.
-- * @O x1 y1 x2 y2 w@ Add a rational quadratic Bézier from the current point to @(x2, y2)@ with control point @(x1, y1)@ and weight @w@.
-- 
-- 
-- All the commands have lowercase variants that interpret coordinates
-- relative to the current point.
-- 
-- The @O@ command is an extension that is not supported in SVG.
-- 
-- /Since: 4.14/
pathParse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: a string
    -> m (Maybe Path)
    -- ^ __Returns:__ a new @GskPath@, or @NULL@ if /@string@/ could not be parsed
pathParse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Path)
pathParse Text
string = IO (Maybe Path) -> m (Maybe Path)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Path) -> m (Maybe Path))
-> IO (Maybe Path) -> m (Maybe Path)
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    Ptr Path
result <- CString -> IO (Ptr Path)
gsk_path_parse CString
string'
    Maybe Path
maybeResult <- Ptr Path -> (Ptr Path -> IO Path) -> IO (Maybe Path)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Path
result ((Ptr Path -> IO Path) -> IO (Maybe Path))
-> (Ptr Path -> IO Path) -> IO (Maybe Path)
forall a b. (a -> b) -> a -> b
$ \Ptr Path
result' -> do
        Path
result'' <- ((ManagedPtr Path -> Path) -> Ptr Path -> IO Path
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Path -> Path
Path) Ptr Path
result'
        Path -> IO Path
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Path
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    Maybe Path -> IO (Maybe Path)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Path
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePathMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePathMethod "foreach" o = PathForeachMethodInfo
    ResolvePathMethod "inFill" o = PathInFillMethodInfo
    ResolvePathMethod "isClosed" o = PathIsClosedMethodInfo
    ResolvePathMethod "isEmpty" o = PathIsEmptyMethodInfo
    ResolvePathMethod "print" o = PathPrintMethodInfo
    ResolvePathMethod "ref" o = PathRefMethodInfo
    ResolvePathMethod "toCairo" o = PathToCairoMethodInfo
    ResolvePathMethod "toString" o = PathToStringMethodInfo
    ResolvePathMethod "unref" o = PathUnrefMethodInfo
    ResolvePathMethod "getBounds" o = PathGetBoundsMethodInfo
    ResolvePathMethod "getStrokeBounds" o = PathGetStrokeBoundsMethodInfo
    ResolvePathMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif