{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Lets you load SVG data and render it.

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

module GI.Rsvg.Objects.Handle
    ( 

-- * Exported types
    Handle(..)                              ,
    IsHandle                                ,
    toHandle                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [close]("GI.Rsvg.Objects.Handle#g:method:close"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasSub]("GI.Rsvg.Objects.Handle#g:method:hasSub"), [internalSetTesting]("GI.Rsvg.Objects.Handle#g:method:internalSetTesting"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [readStreamSync]("GI.Rsvg.Objects.Handle#g:method:readStreamSync"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [renderCairo]("GI.Rsvg.Objects.Handle#g:method:renderCairo"), [renderCairoSub]("GI.Rsvg.Objects.Handle#g:method:renderCairoSub"), [renderDocument]("GI.Rsvg.Objects.Handle#g:method:renderDocument"), [renderElement]("GI.Rsvg.Objects.Handle#g:method:renderElement"), [renderLayer]("GI.Rsvg.Objects.Handle#g:method:renderLayer"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure"), [write]("GI.Rsvg.Objects.Handle#g:method:write").
-- 
-- ==== Getters
-- [getBaseUri]("GI.Rsvg.Objects.Handle#g:method:getBaseUri"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDimensions]("GI.Rsvg.Objects.Handle#g:method:getDimensions"), [getDimensionsSub]("GI.Rsvg.Objects.Handle#g:method:getDimensionsSub"), [getGeometryForElement]("GI.Rsvg.Objects.Handle#g:method:getGeometryForElement"), [getGeometryForLayer]("GI.Rsvg.Objects.Handle#g:method:getGeometryForLayer"), [getIntrinsicDimensions]("GI.Rsvg.Objects.Handle#g:method:getIntrinsicDimensions"), [getIntrinsicSizeInPixels]("GI.Rsvg.Objects.Handle#g:method:getIntrinsicSizeInPixels"), [getPixbuf]("GI.Rsvg.Objects.Handle#g:method:getPixbuf"), [getPixbufSub]("GI.Rsvg.Objects.Handle#g:method:getPixbufSub"), [getPositionSub]("GI.Rsvg.Objects.Handle#g:method:getPositionSub"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setBaseGfile]("GI.Rsvg.Objects.Handle#g:method:setBaseGfile"), [setBaseUri]("GI.Rsvg.Objects.Handle#g:method:setBaseUri"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDpi]("GI.Rsvg.Objects.Handle#g:method:setDpi"), [setDpiXY]("GI.Rsvg.Objects.Handle#g:method:setDpiXY"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setStylesheet]("GI.Rsvg.Objects.Handle#g:method:setStylesheet").

#if defined(ENABLE_OVERLOADING)
    ResolveHandleMethod                     ,
#endif

-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    HandleCloseMethodInfo                   ,
#endif
    handleClose                             ,


-- ** getBaseUri #method:getBaseUri#

#if defined(ENABLE_OVERLOADING)
    HandleGetBaseUriMethodInfo              ,
#endif
    handleGetBaseUri                        ,


-- ** getDimensions #method:getDimensions#

#if defined(ENABLE_OVERLOADING)
    HandleGetDimensionsMethodInfo           ,
#endif
    handleGetDimensions                     ,


-- ** getDimensionsSub #method:getDimensionsSub#

#if defined(ENABLE_OVERLOADING)
    HandleGetDimensionsSubMethodInfo        ,
#endif
    handleGetDimensionsSub                  ,


-- ** getGeometryForElement #method:getGeometryForElement#

#if defined(ENABLE_OVERLOADING)
    HandleGetGeometryForElementMethodInfo   ,
#endif
    handleGetGeometryForElement             ,


-- ** getGeometryForLayer #method:getGeometryForLayer#

#if defined(ENABLE_OVERLOADING)
    HandleGetGeometryForLayerMethodInfo     ,
#endif
    handleGetGeometryForLayer               ,


-- ** getIntrinsicDimensions #method:getIntrinsicDimensions#

#if defined(ENABLE_OVERLOADING)
    HandleGetIntrinsicDimensionsMethodInfo  ,
#endif
    handleGetIntrinsicDimensions            ,


-- ** getIntrinsicSizeInPixels #method:getIntrinsicSizeInPixels#

#if defined(ENABLE_OVERLOADING)
    HandleGetIntrinsicSizeInPixelsMethodInfo,
#endif
    handleGetIntrinsicSizeInPixels          ,


-- ** getPixbuf #method:getPixbuf#

#if defined(ENABLE_OVERLOADING)
    HandleGetPixbufMethodInfo               ,
#endif
    handleGetPixbuf                         ,


-- ** getPixbufSub #method:getPixbufSub#

#if defined(ENABLE_OVERLOADING)
    HandleGetPixbufSubMethodInfo            ,
#endif
    handleGetPixbufSub                      ,


-- ** getPositionSub #method:getPositionSub#

#if defined(ENABLE_OVERLOADING)
    HandleGetPositionSubMethodInfo          ,
#endif
    handleGetPositionSub                    ,


-- ** hasSub #method:hasSub#

#if defined(ENABLE_OVERLOADING)
    HandleHasSubMethodInfo                  ,
#endif
    handleHasSub                            ,


-- ** internalSetTesting #method:internalSetTesting#

#if defined(ENABLE_OVERLOADING)
    HandleInternalSetTestingMethodInfo      ,
#endif
    handleInternalSetTesting                ,


-- ** new #method:new#

    handleNew                               ,


-- ** newFromData #method:newFromData#

    handleNewFromData                       ,


-- ** newFromFile #method:newFromFile#

    handleNewFromFile                       ,


-- ** newFromGfileSync #method:newFromGfileSync#

    handleNewFromGfileSync                  ,


-- ** newFromStreamSync #method:newFromStreamSync#

    handleNewFromStreamSync                 ,


-- ** newWithFlags #method:newWithFlags#

    handleNewWithFlags                      ,


-- ** readStreamSync #method:readStreamSync#

#if defined(ENABLE_OVERLOADING)
    HandleReadStreamSyncMethodInfo          ,
#endif
    handleReadStreamSync                    ,


-- ** renderCairo #method:renderCairo#

#if defined(ENABLE_OVERLOADING)
    HandleRenderCairoMethodInfo             ,
#endif
    handleRenderCairo                       ,


-- ** renderCairoSub #method:renderCairoSub#

#if defined(ENABLE_OVERLOADING)
    HandleRenderCairoSubMethodInfo          ,
#endif
    handleRenderCairoSub                    ,


-- ** renderDocument #method:renderDocument#

#if defined(ENABLE_OVERLOADING)
    HandleRenderDocumentMethodInfo          ,
#endif
    handleRenderDocument                    ,


-- ** renderElement #method:renderElement#

#if defined(ENABLE_OVERLOADING)
    HandleRenderElementMethodInfo           ,
#endif
    handleRenderElement                     ,


-- ** renderLayer #method:renderLayer#

#if defined(ENABLE_OVERLOADING)
    HandleRenderLayerMethodInfo             ,
#endif
    handleRenderLayer                       ,


-- ** setBaseGfile #method:setBaseGfile#

#if defined(ENABLE_OVERLOADING)
    HandleSetBaseGfileMethodInfo            ,
#endif
    handleSetBaseGfile                      ,


-- ** setBaseUri #method:setBaseUri#

#if defined(ENABLE_OVERLOADING)
    HandleSetBaseUriMethodInfo              ,
#endif
    handleSetBaseUri                        ,


-- ** setDpi #method:setDpi#

#if defined(ENABLE_OVERLOADING)
    HandleSetDpiMethodInfo                  ,
#endif
    handleSetDpi                            ,


-- ** setDpiXY #method:setDpiXY#

#if defined(ENABLE_OVERLOADING)
    HandleSetDpiXYMethodInfo                ,
#endif
    handleSetDpiXY                          ,


-- ** setStylesheet #method:setStylesheet#

#if defined(ENABLE_OVERLOADING)
    HandleSetStylesheetMethodInfo           ,
#endif
    handleSetStylesheet                     ,


-- ** write #method:write#

#if defined(ENABLE_OVERLOADING)
    HandleWriteMethodInfo                   ,
#endif
    handleWrite                             ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    HandleBaseUriPropertyInfo               ,
#endif
    constructHandleBaseUri                  ,
    getHandleBaseUri                        ,
#if defined(ENABLE_OVERLOADING)
    handleBaseUri                           ,
#endif
    setHandleBaseUri                        ,


-- ** desc #attr:desc#
-- | SVG\'s description.

#if defined(ENABLE_OVERLOADING)
    HandleDescPropertyInfo                  ,
#endif
    getHandleDesc                           ,
#if defined(ENABLE_OVERLOADING)
    handleDesc                              ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    HandleDpiXPropertyInfo                  ,
#endif
    constructHandleDpiX                     ,
    getHandleDpiX                           ,
#if defined(ENABLE_OVERLOADING)
    handleDpiX                              ,
#endif
    setHandleDpiX                           ,


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

#if defined(ENABLE_OVERLOADING)
    HandleDpiYPropertyInfo                  ,
#endif
    constructHandleDpiY                     ,
    getHandleDpiY                           ,
#if defined(ENABLE_OVERLOADING)
    handleDpiY                              ,
#endif
    setHandleDpiY                           ,


-- ** em #attr:em#
-- | Exact width, in pixels, of the rendered SVG before calling the size callback
-- as specified by @/rsvg_handle_set_size_callback()/@.

#if defined(ENABLE_OVERLOADING)
    HandleEmPropertyInfo                    ,
#endif
    getHandleEm                             ,
#if defined(ENABLE_OVERLOADING)
    handleEm                                ,
#endif


-- ** ex #attr:ex#
-- | Exact height, in pixels, of the rendered SVG before calling the size callback
-- as specified by @/rsvg_handle_set_size_callback()/@.

#if defined(ENABLE_OVERLOADING)
    HandleExPropertyInfo                    ,
#endif
    getHandleEx                             ,
#if defined(ENABLE_OVERLOADING)
    handleEx                                ,
#endif


-- ** flags #attr:flags#
-- | Flags from t'GI.Rsvg.Flags.HandleFlags'.
-- 
-- /Since: 2.36/

#if defined(ENABLE_OVERLOADING)
    HandleFlagsPropertyInfo                 ,
#endif
    constructHandleFlags                    ,
    getHandleFlags                          ,
#if defined(ENABLE_OVERLOADING)
    handleFlags                             ,
#endif


-- ** height #attr:height#
-- | Height, in pixels, of the rendered SVG after calling the size callback
-- as specified by @/rsvg_handle_set_size_callback()/@.

#if defined(ENABLE_OVERLOADING)
    HandleHeightPropertyInfo                ,
#endif
    getHandleHeight                         ,
#if defined(ENABLE_OVERLOADING)
    handleHeight                            ,
#endif


-- ** metadata #attr:metadata#
-- | SVG\'s metadata

#if defined(ENABLE_OVERLOADING)
    HandleMetadataPropertyInfo              ,
#endif
    getHandleMetadata                       ,
#if defined(ENABLE_OVERLOADING)
    handleMetadata                          ,
#endif


-- ** title #attr:title#
-- | SVG\'s title.

#if defined(ENABLE_OVERLOADING)
    HandleTitlePropertyInfo                 ,
#endif
    getHandleTitle                          ,
#if defined(ENABLE_OVERLOADING)
    handleTitle                             ,
#endif


-- ** width #attr:width#
-- | Width, in pixels, of the rendered SVG after calling the size callback
-- as specified by @/rsvg_handle_set_size_callback()/@.

#if defined(ENABLE_OVERLOADING)
    HandleWidthPropertyInfo                 ,
#endif
    getHandleWidth                          ,
#if defined(ENABLE_OVERLOADING)
    handleWidth                             ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.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.Cairo.Structs.Context as Cairo.Context
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.Rsvg.Flags as Rsvg.Flags
import {-# SOURCE #-} qualified GI.Rsvg.Structs.DimensionData as Rsvg.DimensionData
import {-# SOURCE #-} qualified GI.Rsvg.Structs.Length as Rsvg.Length
import {-# SOURCE #-} qualified GI.Rsvg.Structs.PositionData as Rsvg.PositionData
import {-# SOURCE #-} qualified GI.Rsvg.Structs.Rectangle as Rsvg.Rectangle

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

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

foreign import ccall "rsvg_handle_get_type"
    c_rsvg_handle_get_type :: IO B.Types.GType

instance B.Types.TypedObject Handle where
    glibType :: IO GType
glibType = IO GType
c_rsvg_handle_get_type

instance B.Types.GObject Handle

-- | Type class for types which can be safely cast to `Handle`, for instance with `toHandle`.
class (SP.GObject o, O.IsDescendantOf Handle o) => IsHandle o
instance (SP.GObject o, O.IsDescendantOf Handle o) => IsHandle o

instance O.HasParentTypes Handle
type instance O.ParentTypes Handle = '[GObject.Object.Object]

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

-- | Convert 'Handle' 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 Handle) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_rsvg_handle_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Handle -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Handle
P.Nothing = Ptr GValue -> Ptr Handle -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Handle
forall a. Ptr a
FP.nullPtr :: FP.Ptr Handle)
    gvalueSet_ Ptr GValue
gv (P.Just Handle
obj) = Handle -> (Ptr Handle -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Handle
obj (Ptr GValue -> Ptr Handle -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Handle)
gvalueGet_ Ptr GValue
gv = do
        Ptr Handle
ptr <- Ptr GValue -> IO (Ptr Handle)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Handle)
        if Ptr Handle
ptr Ptr Handle -> Ptr Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Handle
forall a. Ptr a
FP.nullPtr
        then Handle -> Maybe Handle
forall a. a -> Maybe a
P.Just (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Handle -> Handle) -> Ptr Handle -> IO Handle
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Handle -> Handle
Handle Ptr Handle
ptr
        else Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveHandleMethod (t :: Symbol) (o :: *) :: * where
    ResolveHandleMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveHandleMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveHandleMethod "close" o = HandleCloseMethodInfo
    ResolveHandleMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveHandleMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveHandleMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveHandleMethod "hasSub" o = HandleHasSubMethodInfo
    ResolveHandleMethod "internalSetTesting" o = HandleInternalSetTestingMethodInfo
    ResolveHandleMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveHandleMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveHandleMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveHandleMethod "readStreamSync" o = HandleReadStreamSyncMethodInfo
    ResolveHandleMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveHandleMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveHandleMethod "renderCairo" o = HandleRenderCairoMethodInfo
    ResolveHandleMethod "renderCairoSub" o = HandleRenderCairoSubMethodInfo
    ResolveHandleMethod "renderDocument" o = HandleRenderDocumentMethodInfo
    ResolveHandleMethod "renderElement" o = HandleRenderElementMethodInfo
    ResolveHandleMethod "renderLayer" o = HandleRenderLayerMethodInfo
    ResolveHandleMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveHandleMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveHandleMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveHandleMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveHandleMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveHandleMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveHandleMethod "write" o = HandleWriteMethodInfo
    ResolveHandleMethod "getBaseUri" o = HandleGetBaseUriMethodInfo
    ResolveHandleMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveHandleMethod "getDimensions" o = HandleGetDimensionsMethodInfo
    ResolveHandleMethod "getDimensionsSub" o = HandleGetDimensionsSubMethodInfo
    ResolveHandleMethod "getGeometryForElement" o = HandleGetGeometryForElementMethodInfo
    ResolveHandleMethod "getGeometryForLayer" o = HandleGetGeometryForLayerMethodInfo
    ResolveHandleMethod "getIntrinsicDimensions" o = HandleGetIntrinsicDimensionsMethodInfo
    ResolveHandleMethod "getIntrinsicSizeInPixels" o = HandleGetIntrinsicSizeInPixelsMethodInfo
    ResolveHandleMethod "getPixbuf" o = HandleGetPixbufMethodInfo
    ResolveHandleMethod "getPixbufSub" o = HandleGetPixbufSubMethodInfo
    ResolveHandleMethod "getPositionSub" o = HandleGetPositionSubMethodInfo
    ResolveHandleMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveHandleMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveHandleMethod "setBaseGfile" o = HandleSetBaseGfileMethodInfo
    ResolveHandleMethod "setBaseUri" o = HandleSetBaseUriMethodInfo
    ResolveHandleMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveHandleMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveHandleMethod "setDpi" o = HandleSetDpiMethodInfo
    ResolveHandleMethod "setDpiXY" o = HandleSetDpiXYMethodInfo
    ResolveHandleMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveHandleMethod "setStylesheet" o = HandleSetStylesheetMethodInfo
    ResolveHandleMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "base-uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@base-uri@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #baseUri
-- @
getHandleBaseUri :: (MonadIO m, IsHandle o) => o -> m T.Text
getHandleBaseUri :: forall (m :: * -> *) o. (MonadIO m, IsHandle o) => o -> m Text
getHandleBaseUri o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getHandleBaseUri" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"base-uri"

-- | Set the value of the “@base-uri@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' handle [ #baseUri 'Data.GI.Base.Attributes.:=' value ]
-- @
setHandleBaseUri :: (MonadIO m, IsHandle o) => o -> T.Text -> m ()
setHandleBaseUri :: forall (m :: * -> *) o.
(MonadIO m, IsHandle o) =>
o -> Text -> m ()
setHandleBaseUri o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"base-uri" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@base-uri@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructHandleBaseUri :: (IsHandle o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructHandleBaseUri :: forall o (m :: * -> *).
(IsHandle o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructHandleBaseUri Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"base-uri" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data HandleBaseUriPropertyInfo
instance AttrInfo HandleBaseUriPropertyInfo where
    type AttrAllowedOps HandleBaseUriPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint HandleBaseUriPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleBaseUriPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint HandleBaseUriPropertyInfo = (~) T.Text
    type AttrTransferType HandleBaseUriPropertyInfo = T.Text
    type AttrGetType HandleBaseUriPropertyInfo = T.Text
    type AttrLabel HandleBaseUriPropertyInfo = "base-uri"
    type AttrOrigin HandleBaseUriPropertyInfo = Handle
    attrGet = getHandleBaseUri
    attrSet = setHandleBaseUri
    attrTransfer _ v = do
        return v
    attrConstruct = constructHandleBaseUri
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.baseUri"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:baseUri"
        })
#endif

-- VVV Prop "desc"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@desc@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #desc
-- @
getHandleDesc :: (MonadIO m, IsHandle o) => o -> m (Maybe T.Text)
getHandleDesc :: forall (m :: * -> *) o.
(MonadIO m, IsHandle o) =>
o -> m (Maybe Text)
getHandleDesc o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"desc"

#if defined(ENABLE_OVERLOADING)
data HandleDescPropertyInfo
instance AttrInfo HandleDescPropertyInfo where
    type AttrAllowedOps HandleDescPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint HandleDescPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleDescPropertyInfo = (~) ()
    type AttrTransferTypeConstraint HandleDescPropertyInfo = (~) ()
    type AttrTransferType HandleDescPropertyInfo = ()
    type AttrGetType HandleDescPropertyInfo = (Maybe T.Text)
    type AttrLabel HandleDescPropertyInfo = "desc"
    type AttrOrigin HandleDescPropertyInfo = Handle
    attrGet = getHandleDesc
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.desc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:desc"
        })
#endif

-- VVV Prop "dpi-x"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@dpi-x@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #dpiX
-- @
getHandleDpiX :: (MonadIO m, IsHandle o) => o -> m Double
getHandleDpiX :: forall (m :: * -> *) o. (MonadIO m, IsHandle o) => o -> m Double
getHandleDpiX o
obj = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"dpi-x"

-- | Set the value of the “@dpi-x@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' handle [ #dpiX 'Data.GI.Base.Attributes.:=' value ]
-- @
setHandleDpiX :: (MonadIO m, IsHandle o) => o -> Double -> m ()
setHandleDpiX :: forall (m :: * -> *) o.
(MonadIO m, IsHandle o) =>
o -> Double -> m ()
setHandleDpiX o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"dpi-x" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@dpi-x@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructHandleDpiX :: (IsHandle o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructHandleDpiX :: forall o (m :: * -> *).
(IsHandle o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructHandleDpiX Double
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"dpi-x" Double
val

#if defined(ENABLE_OVERLOADING)
data HandleDpiXPropertyInfo
instance AttrInfo HandleDpiXPropertyInfo where
    type AttrAllowedOps HandleDpiXPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint HandleDpiXPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleDpiXPropertyInfo = (~) Double
    type AttrTransferTypeConstraint HandleDpiXPropertyInfo = (~) Double
    type AttrTransferType HandleDpiXPropertyInfo = Double
    type AttrGetType HandleDpiXPropertyInfo = Double
    type AttrLabel HandleDpiXPropertyInfo = "dpi-x"
    type AttrOrigin HandleDpiXPropertyInfo = Handle
    attrGet = getHandleDpiX
    attrSet = setHandleDpiX
    attrTransfer _ v = do
        return v
    attrConstruct = constructHandleDpiX
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.dpiX"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:dpiX"
        })
#endif

-- VVV Prop "dpi-y"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@dpi-y@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #dpiY
-- @
getHandleDpiY :: (MonadIO m, IsHandle o) => o -> m Double
getHandleDpiY :: forall (m :: * -> *) o. (MonadIO m, IsHandle o) => o -> m Double
getHandleDpiY o
obj = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"dpi-y"

-- | Set the value of the “@dpi-y@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' handle [ #dpiY 'Data.GI.Base.Attributes.:=' value ]
-- @
setHandleDpiY :: (MonadIO m, IsHandle o) => o -> Double -> m ()
setHandleDpiY :: forall (m :: * -> *) o.
(MonadIO m, IsHandle o) =>
o -> Double -> m ()
setHandleDpiY o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"dpi-y" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@dpi-y@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructHandleDpiY :: (IsHandle o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructHandleDpiY :: forall o (m :: * -> *).
(IsHandle o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructHandleDpiY Double
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"dpi-y" Double
val

#if defined(ENABLE_OVERLOADING)
data HandleDpiYPropertyInfo
instance AttrInfo HandleDpiYPropertyInfo where
    type AttrAllowedOps HandleDpiYPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint HandleDpiYPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleDpiYPropertyInfo = (~) Double
    type AttrTransferTypeConstraint HandleDpiYPropertyInfo = (~) Double
    type AttrTransferType HandleDpiYPropertyInfo = Double
    type AttrGetType HandleDpiYPropertyInfo = Double
    type AttrLabel HandleDpiYPropertyInfo = "dpi-y"
    type AttrOrigin HandleDpiYPropertyInfo = Handle
    attrGet = getHandleDpiY
    attrSet = setHandleDpiY
    attrTransfer _ v = do
        return v
    attrConstruct = constructHandleDpiY
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.dpiY"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:dpiY"
        })
#endif

-- VVV Prop "em"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@em@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #em
-- @
getHandleEm :: (MonadIO m, IsHandle o) => o -> m Double
getHandleEm :: forall (m :: * -> *) o. (MonadIO m, IsHandle o) => o -> m Double
getHandleEm o
obj = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"em"

#if defined(ENABLE_OVERLOADING)
data HandleEmPropertyInfo
instance AttrInfo HandleEmPropertyInfo where
    type AttrAllowedOps HandleEmPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint HandleEmPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleEmPropertyInfo = (~) ()
    type AttrTransferTypeConstraint HandleEmPropertyInfo = (~) ()
    type AttrTransferType HandleEmPropertyInfo = ()
    type AttrGetType HandleEmPropertyInfo = Double
    type AttrLabel HandleEmPropertyInfo = "em"
    type AttrOrigin HandleEmPropertyInfo = Handle
    attrGet = getHandleEm
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.em"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:em"
        })
#endif

-- VVV Prop "ex"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@ex@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #ex
-- @
getHandleEx :: (MonadIO m, IsHandle o) => o -> m Double
getHandleEx :: forall (m :: * -> *) o. (MonadIO m, IsHandle o) => o -> m Double
getHandleEx o
obj = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"ex"

#if defined(ENABLE_OVERLOADING)
data HandleExPropertyInfo
instance AttrInfo HandleExPropertyInfo where
    type AttrAllowedOps HandleExPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint HandleExPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleExPropertyInfo = (~) ()
    type AttrTransferTypeConstraint HandleExPropertyInfo = (~) ()
    type AttrTransferType HandleExPropertyInfo = ()
    type AttrGetType HandleExPropertyInfo = Double
    type AttrLabel HandleExPropertyInfo = "ex"
    type AttrOrigin HandleExPropertyInfo = Handle
    attrGet = getHandleEx
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.ex"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:ex"
        })
#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Rsvg", name = "HandleFlags"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #flags
-- @
getHandleFlags :: (MonadIO m, IsHandle o) => o -> m [Rsvg.Flags.HandleFlags]
getHandleFlags :: forall (m :: * -> *) o.
(MonadIO m, IsHandle o) =>
o -> m [HandleFlags]
getHandleFlags o
obj = IO [HandleFlags] -> m [HandleFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [HandleFlags] -> m [HandleFlags])
-> IO [HandleFlags] -> m [HandleFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [HandleFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Construct a `GValueConstruct` with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructHandleFlags :: (IsHandle o, MIO.MonadIO m) => [Rsvg.Flags.HandleFlags] -> m (GValueConstruct o)
constructHandleFlags :: forall o (m :: * -> *).
(IsHandle o, MonadIO m) =>
[HandleFlags] -> m (GValueConstruct o)
constructHandleFlags [HandleFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [HandleFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [HandleFlags]
val

#if defined(ENABLE_OVERLOADING)
data HandleFlagsPropertyInfo
instance AttrInfo HandleFlagsPropertyInfo where
    type AttrAllowedOps HandleFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint HandleFlagsPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleFlagsPropertyInfo = (~) [Rsvg.Flags.HandleFlags]
    type AttrTransferTypeConstraint HandleFlagsPropertyInfo = (~) [Rsvg.Flags.HandleFlags]
    type AttrTransferType HandleFlagsPropertyInfo = [Rsvg.Flags.HandleFlags]
    type AttrGetType HandleFlagsPropertyInfo = [Rsvg.Flags.HandleFlags]
    type AttrLabel HandleFlagsPropertyInfo = "flags"
    type AttrOrigin HandleFlagsPropertyInfo = Handle
    attrGet = getHandleFlags
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructHandleFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:flags"
        })
#endif

-- VVV Prop "height"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #height
-- @
getHandleHeight :: (MonadIO m, IsHandle o) => o -> m Int32
getHandleHeight :: forall (m :: * -> *) o. (MonadIO m, IsHandle o) => o -> m Int32
getHandleHeight o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"height"

#if defined(ENABLE_OVERLOADING)
data HandleHeightPropertyInfo
instance AttrInfo HandleHeightPropertyInfo where
    type AttrAllowedOps HandleHeightPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint HandleHeightPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleHeightPropertyInfo = (~) ()
    type AttrTransferTypeConstraint HandleHeightPropertyInfo = (~) ()
    type AttrTransferType HandleHeightPropertyInfo = ()
    type AttrGetType HandleHeightPropertyInfo = Int32
    type AttrLabel HandleHeightPropertyInfo = "height"
    type AttrOrigin HandleHeightPropertyInfo = Handle
    attrGet = getHandleHeight
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.height"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:height"
        })
#endif

-- VVV Prop "metadata"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@metadata@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #metadata
-- @
getHandleMetadata :: (MonadIO m, IsHandle o) => o -> m (Maybe T.Text)
getHandleMetadata :: forall (m :: * -> *) o.
(MonadIO m, IsHandle o) =>
o -> m (Maybe Text)
getHandleMetadata o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"metadata"

#if defined(ENABLE_OVERLOADING)
data HandleMetadataPropertyInfo
instance AttrInfo HandleMetadataPropertyInfo where
    type AttrAllowedOps HandleMetadataPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint HandleMetadataPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleMetadataPropertyInfo = (~) ()
    type AttrTransferTypeConstraint HandleMetadataPropertyInfo = (~) ()
    type AttrTransferType HandleMetadataPropertyInfo = ()
    type AttrGetType HandleMetadataPropertyInfo = (Maybe T.Text)
    type AttrLabel HandleMetadataPropertyInfo = "metadata"
    type AttrOrigin HandleMetadataPropertyInfo = Handle
    attrGet = getHandleMetadata
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.metadata"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:metadata"
        })
#endif

-- VVV Prop "title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #title
-- @
getHandleTitle :: (MonadIO m, IsHandle o) => o -> m (Maybe T.Text)
getHandleTitle :: forall (m :: * -> *) o.
(MonadIO m, IsHandle o) =>
o -> m (Maybe Text)
getHandleTitle o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"title"

#if defined(ENABLE_OVERLOADING)
data HandleTitlePropertyInfo
instance AttrInfo HandleTitlePropertyInfo where
    type AttrAllowedOps HandleTitlePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint HandleTitlePropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleTitlePropertyInfo = (~) ()
    type AttrTransferTypeConstraint HandleTitlePropertyInfo = (~) ()
    type AttrTransferType HandleTitlePropertyInfo = ()
    type AttrGetType HandleTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel HandleTitlePropertyInfo = "title"
    type AttrOrigin HandleTitlePropertyInfo = Handle
    attrGet = getHandleTitle
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:title"
        })
#endif

-- VVV Prop "width"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' handle #width
-- @
getHandleWidth :: (MonadIO m, IsHandle o) => o -> m Int32
getHandleWidth :: forall (m :: * -> *) o. (MonadIO m, IsHandle o) => o -> m Int32
getHandleWidth o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"width"

#if defined(ENABLE_OVERLOADING)
data HandleWidthPropertyInfo
instance AttrInfo HandleWidthPropertyInfo where
    type AttrAllowedOps HandleWidthPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint HandleWidthPropertyInfo = IsHandle
    type AttrSetTypeConstraint HandleWidthPropertyInfo = (~) ()
    type AttrTransferTypeConstraint HandleWidthPropertyInfo = (~) ()
    type AttrTransferType HandleWidthPropertyInfo = ()
    type AttrGetType HandleWidthPropertyInfo = Int32
    type AttrLabel HandleWidthPropertyInfo = "width"
    type AttrOrigin HandleWidthPropertyInfo = Handle
    attrGet = getHandleWidth
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.width"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#g:attr:width"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Handle
type instance O.AttributeList Handle = HandleAttributeList
type HandleAttributeList = ('[ '("baseUri", HandleBaseUriPropertyInfo), '("desc", HandleDescPropertyInfo), '("dpiX", HandleDpiXPropertyInfo), '("dpiY", HandleDpiYPropertyInfo), '("em", HandleEmPropertyInfo), '("ex", HandleExPropertyInfo), '("flags", HandleFlagsPropertyInfo), '("height", HandleHeightPropertyInfo), '("metadata", HandleMetadataPropertyInfo), '("title", HandleTitlePropertyInfo), '("width", HandleWidthPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
handleBaseUri :: AttrLabelProxy "baseUri"
handleBaseUri = AttrLabelProxy

handleDesc :: AttrLabelProxy "desc"
handleDesc = AttrLabelProxy

handleDpiX :: AttrLabelProxy "dpiX"
handleDpiX = AttrLabelProxy

handleDpiY :: AttrLabelProxy "dpiY"
handleDpiY = AttrLabelProxy

handleEm :: AttrLabelProxy "em"
handleEm = AttrLabelProxy

handleEx :: AttrLabelProxy "ex"
handleEx = AttrLabelProxy

handleFlags :: AttrLabelProxy "flags"
handleFlags = AttrLabelProxy

handleHeight :: AttrLabelProxy "height"
handleHeight = AttrLabelProxy

handleMetadata :: AttrLabelProxy "metadata"
handleMetadata = AttrLabelProxy

handleTitle :: AttrLabelProxy "title"
handleTitle = AttrLabelProxy

handleWidth :: AttrLabelProxy "width"
handleWidth = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Handle = HandleSignalList
type HandleSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Handle::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Rsvg" , name = "Handle" })
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_new" rsvg_handle_new :: 
    IO (Ptr Handle)

-- | Returns a new rsvg handle.  Must be freed with /@gObjectUnref@/.  This
-- handle can be used to load an image.
-- 
-- The preferred way of loading SVG data into the returned t'GI.Rsvg.Objects.Handle.Handle' is with
-- 'GI.Rsvg.Objects.Handle.handleReadStreamSync'.
-- 
-- The deprecated way of loading SVG data is with 'GI.Rsvg.Objects.Handle.handleWrite' and
-- 'GI.Rsvg.Objects.Handle.handleClose'; note that these require buffering the entire file
-- internally, and for this reason it is better to use the stream functions:
-- 'GI.Rsvg.Objects.Handle.handleNewFromStreamSync', 'GI.Rsvg.Objects.Handle.handleReadStreamSync', or
-- 'GI.Rsvg.Objects.Handle.handleNewFromGfileSync'.
-- 
-- After loading the t'GI.Rsvg.Objects.Handle.Handle' with data, you can render it using Cairo or get
-- a GdkPixbuf from it. When finished, free the handle with 'GI.GObject.Objects.Object.objectUnref'. No
-- more than one image can be loaded with one handle.
-- 
-- Note that this function creates an t'GI.Rsvg.Objects.Handle.Handle' with no flags set.  If you
-- require any of t'GI.Rsvg.Flags.HandleFlags' to be set, use any of
-- 'GI.Rsvg.Objects.Handle.handleNewWithFlags', 'GI.Rsvg.Objects.Handle.handleNewFromStreamSync', or
-- 'GI.Rsvg.Objects.Handle.handleNewFromGfileSync'.
handleNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Handle
    -- ^ __Returns:__ A new t'GI.Rsvg.Objects.Handle.Handle' with no flags set.
handleNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Handle
handleNew  = IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
result <- IO (Ptr Handle)
rsvg_handle_new
    Text -> Ptr Handle -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"handleNew" Ptr Handle
result
    Handle
result' <- ((ManagedPtr Handle -> Handle) -> Ptr Handle -> IO Handle
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Handle -> Handle
Handle) Ptr Handle
result
    Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Handle::new_from_data
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The SVG data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data_len"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The length of @data, in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "data_len"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "The length of @data, in bytes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Rsvg" , name = "Handle" })
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_new_from_data" rsvg_handle_new_from_data :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Word64 ->                               -- data_len : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Handle)

-- | Loads the SVG specified by /@data@/.  Note that this function creates an
-- t'GI.Rsvg.Objects.Handle.Handle' without a base URL, and without any t'GI.Rsvg.Flags.HandleFlags'.  If you
-- need these, use 'GI.Rsvg.Objects.Handle.handleNewFromStreamSync' instead by creating
-- a t'GI.Gio.Objects.MemoryInputStream.MemoryInputStream' from your data.
-- 
-- /Since: 2.14/
handleNewFromData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: The SVG data
    -> m (Maybe Handle)
    -- ^ __Returns:__ A t'GI.Rsvg.Objects.Handle.Handle' or 'P.Nothing' if an error occurs. /(Can throw 'Data.GI.Base.GError.GError')/
handleNewFromData :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m (Maybe Handle)
handleNewFromData ByteString
data_ = IO (Maybe Handle) -> m (Maybe Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle) -> m (Maybe Handle))
-> IO (Maybe Handle) -> m (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ do
    let dataLen :: Word64
dataLen = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    IO (Maybe Handle) -> IO () -> IO (Maybe Handle)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Handle
result <- (Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle))
-> (Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Word64 -> Ptr (Ptr GError) -> IO (Ptr Handle)
rsvg_handle_new_from_data Ptr Word8
data_' Word64
dataLen
        Maybe Handle
maybeResult <- Ptr Handle -> (Ptr Handle -> IO Handle) -> IO (Maybe Handle)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Handle
result ((Ptr Handle -> IO Handle) -> IO (Maybe Handle))
-> (Ptr Handle -> IO Handle) -> IO (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ \Ptr Handle
result' -> do
            Handle
result'' <- ((ManagedPtr Handle -> Handle) -> Ptr Handle -> IO Handle
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Handle -> Handle
Handle) Ptr Handle
result'
            Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
result''
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
        Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
maybeResult
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Handle::new_from_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The file name to load, or a URI."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Rsvg" , name = "Handle" })
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_new_from_file" rsvg_handle_new_from_file :: 
    CString ->                              -- filename : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Handle)

-- | Loads the SVG specified by /@fileName@/.  Note that this function, like
-- 'GI.Rsvg.Objects.Handle.handleNew', does not specify any loading flags for the resulting
-- handle.  If you require the use of t'GI.Rsvg.Flags.HandleFlags', use
-- 'GI.Rsvg.Objects.Handle.handleNewFromGfileSync'.
-- 
-- /Since: 2.14/
handleNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@filename@/: The file name to load, or a URI.
    -> m (Maybe Handle)
    -- ^ __Returns:__ A t'GI.Rsvg.Objects.Handle.Handle' or 'P.Nothing' if an error occurs. /(Can throw 'Data.GI.Base.GError.GError')/
handleNewFromFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Handle)
handleNewFromFile Text
filename = IO (Maybe Handle) -> m (Maybe Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle) -> m (Maybe Handle))
-> IO (Maybe Handle) -> m (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    IO (Maybe Handle) -> IO () -> IO (Maybe Handle)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Handle
result <- (Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle))
-> (Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr Handle)
rsvg_handle_new_from_file CString
filename'
        Maybe Handle
maybeResult <- Ptr Handle -> (Ptr Handle -> IO Handle) -> IO (Maybe Handle)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Handle
result ((Ptr Handle -> IO Handle) -> IO (Maybe Handle))
-> (Ptr Handle -> IO Handle) -> IO (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ \Ptr Handle
result' -> do
            Handle
result'' <- ((ManagedPtr Handle -> Handle) -> Ptr Handle -> IO Handle
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Handle -> Handle
Handle) Ptr Handle
result'
            Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
result''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Handle::new_from_gfile_sync
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "HandleFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags from #RsvgHandleFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Rsvg" , name = "Handle" })
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_new_from_gfile_sync" rsvg_handle_new_from_gfile_sync :: 
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Rsvg", name = "HandleFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Handle)

-- | Creates a new t'GI.Rsvg.Objects.Handle.Handle' for /@file@/.
-- 
-- This function sets the \"base file\" of the handle to be /@file@/ itself, so SVG
-- elements like \<literal>&lt;image&gt;\<\/literal> which reference external
-- resources will be resolved relative to the location of /@file@/.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned in /@error@/.
-- 
-- /Since: 2.32/
handleNewFromGfileSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> [Rsvg.Flags.HandleFlags]
    -- ^ /@flags@/: flags from t'GI.Rsvg.Flags.HandleFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m (Maybe Handle)
    -- ^ __Returns:__ a new t'GI.Rsvg.Objects.Handle.Handle' on success, or 'P.Nothing' with /@error@/ filled in /(Can throw 'Data.GI.Base.GError.GError')/
handleNewFromGfileSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [HandleFlags] -> Maybe b -> m (Maybe Handle)
handleNewFromGfileSync a
file [HandleFlags]
flags Maybe b
cancellable = IO (Maybe Handle) -> m (Maybe Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle) -> m (Maybe Handle))
-> IO (Maybe Handle) -> m (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [HandleFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [HandleFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Maybe Handle) -> IO () -> IO (Maybe Handle)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Handle
result <- (Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle))
-> (Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CUInt -> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr Handle)
rsvg_handle_new_from_gfile_sync Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable
        Maybe Handle
maybeResult <- Ptr Handle -> (Ptr Handle -> IO Handle) -> IO (Maybe Handle)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Handle
result ((Ptr Handle -> IO Handle) -> IO (Maybe Handle))
-> (Ptr Handle -> IO Handle) -> IO (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ \Ptr Handle
result' -> do
            Handle
result'' <- ((ManagedPtr Handle -> Handle) -> Ptr Handle -> IO Handle
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Handle -> Handle
Handle) Ptr Handle
result'
            Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Handle::new_from_stream_sync
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "input_stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInputStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "base_file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile, or %NULL" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "HandleFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags from #RsvgHandleFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Rsvg" , name = "Handle" })
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_new_from_stream_sync" rsvg_handle_new_from_stream_sync :: 
    Ptr Gio.InputStream.InputStream ->      -- input_stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Ptr Gio.File.File ->                    -- base_file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Rsvg", name = "HandleFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Handle)

-- | Creates a new t'GI.Rsvg.Objects.Handle.Handle' for /@stream@/.
-- 
-- This function sets the \"base file\" of the handle to be /@baseFile@/ if
-- provided.  SVG elements like \<literal>&lt;image&gt;\<\/literal> which reference
-- external resources will be resolved relative to the location of /@baseFile@/.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned in /@error@/.
-- 
-- /Since: 2.32/
handleNewFromStreamSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.InputStream.IsInputStream a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@inputStream@/: a t'GI.Gio.Objects.InputStream.InputStream'
    -> Maybe (b)
    -- ^ /@baseFile@/: a t'GI.Gio.Interfaces.File.File', or 'P.Nothing'
    -> [Rsvg.Flags.HandleFlags]
    -- ^ /@flags@/: flags from t'GI.Rsvg.Flags.HandleFlags'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m (Maybe Handle)
    -- ^ __Returns:__ a new t'GI.Rsvg.Objects.Handle.Handle' on success, or 'P.Nothing' with /@error@/ filled in /(Can throw 'Data.GI.Base.GError.GError')/
handleNewFromStreamSync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsInputStream a, IsFile b,
 IsCancellable c) =>
a -> Maybe b -> [HandleFlags] -> Maybe c -> m (Maybe Handle)
handleNewFromStreamSync a
inputStream Maybe b
baseFile [HandleFlags]
flags Maybe c
cancellable = IO (Maybe Handle) -> m (Maybe Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle) -> m (Maybe Handle))
-> IO (Maybe Handle) -> m (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputStream
inputStream' <- a -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inputStream
    Ptr File
maybeBaseFile <- case Maybe b
baseFile of
        Maybe b
Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just b
jBaseFile -> do
            Ptr File
jBaseFile' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jBaseFile
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jBaseFile'
    let flags' :: CUInt
flags' = [HandleFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [HandleFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Maybe Handle) -> IO () -> IO (Maybe Handle)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Handle
result <- (Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle))
-> (Ptr (Ptr GError) -> IO (Ptr Handle)) -> IO (Ptr Handle)
forall a b. (a -> b) -> a -> b
$ Ptr InputStream
-> Ptr File
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Handle)
rsvg_handle_new_from_stream_sync Ptr InputStream
inputStream' Ptr File
maybeBaseFile CUInt
flags' Ptr Cancellable
maybeCancellable
        Maybe Handle
maybeResult <- Ptr Handle -> (Ptr Handle -> IO Handle) -> IO (Maybe Handle)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Handle
result ((Ptr Handle -> IO Handle) -> IO (Maybe Handle))
-> (Ptr Handle -> IO Handle) -> IO (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ \Ptr Handle
result' -> do
            Handle
result'' <- ((ManagedPtr Handle -> Handle) -> Ptr Handle -> IO Handle
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Handle -> Handle
Handle) Ptr Handle
result'
            Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inputStream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
baseFile b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Handle::new_with_flags
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "HandleFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags from #RsvgHandleFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Rsvg" , name = "Handle" })
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_new_with_flags" rsvg_handle_new_with_flags :: 
    CUInt ->                                -- flags : TInterface (Name {namespace = "Rsvg", name = "HandleFlags"})
    IO (Ptr Handle)

-- | Creates a new t'GI.Rsvg.Objects.Handle.Handle' with flags /@flags@/.  After calling this function,
-- you can feed the resulting handle with SVG data by using
-- 'GI.Rsvg.Objects.Handle.handleReadStreamSync'.
-- 
-- /Since: 2.36/
handleNewWithFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Rsvg.Flags.HandleFlags]
    -- ^ /@flags@/: flags from t'GI.Rsvg.Flags.HandleFlags'
    -> m Handle
    -- ^ __Returns:__ a new t'GI.Rsvg.Objects.Handle.Handle'
handleNewWithFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[HandleFlags] -> m Handle
handleNewWithFlags [HandleFlags]
flags = IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ do
    let flags' :: CUInt
flags' = [HandleFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [HandleFlags]
flags
    Ptr Handle
result <- CUInt -> IO (Ptr Handle)
rsvg_handle_new_with_flags CUInt
flags'
    Text -> Ptr Handle -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"handleNewWithFlags" Ptr Handle
result
    Handle
result' <- ((ManagedPtr Handle -> Handle) -> Ptr Handle -> IO Handle
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Handle -> Handle
Handle) Ptr Handle
result
    Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Handle::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_close" rsvg_handle_close :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED handleClose ["(Since version 2.46.)","Use 'GI.Rsvg.Objects.Handle.handleReadStreamSync' or the constructor","functions 'GI.Rsvg.Objects.Handle.handleNewFromGfileSync' or","'GI.Rsvg.Objects.Handle.handleNewFromStreamSync'.  See the deprecation notes for","'GI.Rsvg.Objects.Handle.handleWrite' for more information."] #-}
-- | This is used after calling 'GI.Rsvg.Objects.Handle.handleWrite' to indicate that there is no more data
-- to consume, and to start the actual parsing of the SVG document.  The only reason to
-- call this function is if you use use 'GI.Rsvg.Objects.Handle.handleWrite' to feed data into the /@handle@/;
-- if you use the other methods like 'GI.Rsvg.Objects.Handle.handleNewFromFile' or
-- 'GI.Rsvg.Objects.Handle.handleReadStreamSync', then you do not need to call this function.
-- 
-- This will return 'P.True' if the loader closed successfully and the
-- SVG data was parsed correctly.  Note that /@handle@/ isn\'t freed until
-- /@gObjectUnref@/ is called.
handleClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: a t'GI.Rsvg.Objects.Handle.Handle'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> m ()
handleClose a
handle = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle -> Ptr (Ptr GError) -> IO CInt
rsvg_handle_close Ptr Handle
handle'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data HandleCloseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleCloseMethodInfo a signature where
    overloadedMethod = handleClose

instance O.OverloadedMethodInfo HandleCloseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleClose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleClose"
        })


#endif

-- method Handle::get_base_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_get_base_uri" rsvg_handle_get_base_uri :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    IO CString

-- | Gets the base uri for this t'GI.Rsvg.Objects.Handle.Handle'.
-- 
-- /Since: 2.8/
handleGetBaseUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: A t'GI.Rsvg.Objects.Handle.Handle'
    -> m T.Text
    -- ^ __Returns:__ the base uri, possibly null
handleGetBaseUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> m Text
handleGetBaseUri a
handle = IO Text -> m Text
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 Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    CString
result <- Ptr Handle -> IO CString
rsvg_handle_get_base_uri Ptr Handle
handle'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"handleGetBaseUri" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data HandleGetBaseUriMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetBaseUriMethodInfo a signature where
    overloadedMethod = handleGetBaseUri

instance O.OverloadedMethodInfo HandleGetBaseUriMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetBaseUri",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetBaseUri"
        })


#endif

-- method Handle::get_dimensions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dimension_data"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "DimensionData" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A place to store the SVG's size"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_get_dimensions" rsvg_handle_get_dimensions :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Rsvg.DimensionData.DimensionData -> -- dimension_data : TInterface (Name {namespace = "Rsvg", name = "DimensionData"})
    IO ()

{-# DEPRECATED handleGetDimensions ["(Since version 2.52.)","Use 'GI.Rsvg.Objects.Handle.handleGetIntrinsicSizeInPixels' instead.  This","function is deprecated because it is not able to return exact fractional dimensions,","only integer pixels."] #-}
-- | Get the SVG\'s size. Do not call from within the size_func callback, because
-- an infinite loop will occur.
-- 
-- This function depends on the t'GI.Rsvg.Objects.Handle.Handle'\'s DPI to compute dimensions in
-- pixels, so you should call 'GI.Rsvg.Objects.Handle.handleSetDpi' beforehand.
-- 
-- /Since: 2.14/
handleGetDimensions ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: A t'GI.Rsvg.Objects.Handle.Handle'
    -> m (Rsvg.DimensionData.DimensionData)
handleGetDimensions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> m DimensionData
handleGetDimensions a
handle = IO DimensionData -> m DimensionData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DimensionData -> m DimensionData)
-> IO DimensionData -> m DimensionData
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr DimensionData
dimensionData <- Int -> IO (Ptr DimensionData)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr Rsvg.DimensionData.DimensionData)
    Ptr Handle -> Ptr DimensionData -> IO ()
rsvg_handle_get_dimensions Ptr Handle
handle' Ptr DimensionData
dimensionData
    DimensionData
dimensionData' <- ((ManagedPtr DimensionData -> DimensionData)
-> Ptr DimensionData -> IO DimensionData
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr DimensionData -> DimensionData
Rsvg.DimensionData.DimensionData) Ptr DimensionData
dimensionData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    DimensionData -> IO DimensionData
forall (m :: * -> *) a. Monad m => a -> m a
return DimensionData
dimensionData'

#if defined(ENABLE_OVERLOADING)
data HandleGetDimensionsMethodInfo
instance (signature ~ (m (Rsvg.DimensionData.DimensionData)), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetDimensionsMethodInfo a signature where
    overloadedMethod = handleGetDimensions

instance O.OverloadedMethodInfo HandleGetDimensionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetDimensions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetDimensions"
        })


#endif

-- method Handle::get_dimensions_sub
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dimension_data"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "DimensionData" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A place to store the SVG's size"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"#\" (a single\nhash character), for example, \"##layer1\".  This notation corresponds to a\nURL's fragment ID.  Alternatively, pass %NULL to use the whole SVG."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_get_dimensions_sub" rsvg_handle_get_dimensions_sub :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Rsvg.DimensionData.DimensionData -> -- dimension_data : TInterface (Name {namespace = "Rsvg", name = "DimensionData"})
    CString ->                              -- id : TBasicType TUTF8
    IO CInt

{-# DEPRECATED handleGetDimensionsSub ["(Since version 2.46.)","Use 'GI.Rsvg.Objects.Handle.handleGetGeometryForLayer' instead."] #-}
-- | Get the size of a subelement of the SVG file. Do not call from within the
-- size_func callback, because an infinite loop will occur.
-- 
-- This function depends on the t'GI.Rsvg.Objects.Handle.Handle'\'s DPI to compute dimensions in
-- pixels, so you should call 'GI.Rsvg.Objects.Handle.handleSetDpi' beforehand.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- /Since: 2.22/
handleGetDimensionsSub ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: A t'GI.Rsvg.Objects.Handle.Handle'
    -> Maybe (T.Text)
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"#\" (a single
    -- hash character), for example, \"#@/layer1/@\".  This notation corresponds to a
    -- URL\'s fragment ID.  Alternatively, pass 'P.Nothing' to use the whole SVG.
    -> m ((Bool, Rsvg.DimensionData.DimensionData))
handleGetDimensionsSub :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Maybe Text -> m (Bool, DimensionData)
handleGetDimensionsSub a
handle Maybe Text
id = IO (Bool, DimensionData) -> m (Bool, DimensionData)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, DimensionData) -> m (Bool, DimensionData))
-> IO (Bool, DimensionData) -> m (Bool, DimensionData)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr DimensionData
dimensionData <- Int -> IO (Ptr DimensionData)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr Rsvg.DimensionData.DimensionData)
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    CInt
result <- Ptr Handle -> Ptr DimensionData -> CString -> IO CInt
rsvg_handle_get_dimensions_sub Ptr Handle
handle' Ptr DimensionData
dimensionData CString
maybeId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    DimensionData
dimensionData' <- ((ManagedPtr DimensionData -> DimensionData)
-> Ptr DimensionData -> IO DimensionData
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr DimensionData -> DimensionData
Rsvg.DimensionData.DimensionData) Ptr DimensionData
dimensionData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
    (Bool, DimensionData) -> IO (Bool, DimensionData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', DimensionData
dimensionData')

#if defined(ENABLE_OVERLOADING)
data HandleGetDimensionsSubMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ((Bool, Rsvg.DimensionData.DimensionData))), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetDimensionsSubMethodInfo a signature where
    overloadedMethod = handleGetDimensionsSub

instance O.OverloadedMethodInfo HandleGetDimensionsSubMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetDimensionsSub",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetDimensionsSub"
        })


#endif

-- method Handle::get_geometry_for_element
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"##\" (a single\nhash character), for example, \"##layer1\".  This notation corresponds to a\nURL's fragment ID.  Alternatively, pass %NULL to compute the geometry for the\nwhole SVG."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_ink_rect"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Place to store the ink rectangle of the element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_logical_rect"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Place to store the logical rectangle of the element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_get_geometry_for_element" rsvg_handle_get_geometry_for_element :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    CString ->                              -- id : TBasicType TUTF8
    Ptr Rsvg.Rectangle.Rectangle ->         -- out_ink_rect : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    Ptr Rsvg.Rectangle.Rectangle ->         -- out_logical_rect : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Computes the ink rectangle and logical rectangle of a single SVG element.
-- 
-- While @rsvg_handle_get_geometry_for_layer@ computes the geometry of an SVG element subtree with
-- its transformation matrix, this other function will compute the element\'s geometry
-- as if it were being rendered under an identity transformation by itself.  That is,
-- the resulting geometry is as if the element got extracted by itself from the SVG.
-- 
-- This function is the counterpart to @rsvg_handle_render_element@.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- The \"ink rectangle\" is the bounding box that would be painted
-- for fully- stroked and filled elements.
-- 
-- The \"logical rectangle\" just takes into account the unstroked
-- paths and text outlines.
-- 
-- Note that these bounds are not minimum bounds; for example,
-- clipping paths are not taken into account.
-- 
-- You can pass @/NULL/@ for the /@id@/ if you want to measure all
-- the elements in the SVG, i.e. to measure everything from the
-- root element.
-- 
-- This operation is not constant-time, as it involves going through all
-- the child elements.
-- 
-- API ordering: This function must be called on a fully-loaded /@handle@/.  See
-- the section \<ulink url=\"RsvgHandle.html@/API/@-ordering\">API ordering\<\/ulink> for details.
-- 
-- Panics: this function will panic if the /@handle@/ is not fully-loaded.
-- 
-- /Since: 2.46/
handleGetGeometryForElement ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> Maybe (T.Text)
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"##\" (a single
    -- hash character), for example, \"#@/layer1/@\".  This notation corresponds to a
    -- URL\'s fragment ID.  Alternatively, pass 'P.Nothing' to compute the geometry for the
    -- whole SVG.
    -> m ((Rsvg.Rectangle.Rectangle, Rsvg.Rectangle.Rectangle))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleGetGeometryForElement :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Maybe Text -> m (Rectangle, Rectangle)
handleGetGeometryForElement a
handle Maybe Text
id = IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle))
-> IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    Ptr Rectangle
outInkRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
32 :: IO (Ptr Rsvg.Rectangle.Rectangle)
    Ptr Rectangle
outLogicalRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
32 :: IO (Ptr Rsvg.Rectangle.Rectangle)
    IO (Rectangle, Rectangle) -> IO () -> IO (Rectangle, Rectangle)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle
-> CString
-> Ptr Rectangle
-> Ptr Rectangle
-> Ptr (Ptr GError)
-> IO CInt
rsvg_handle_get_geometry_for_element Ptr Handle
handle' CString
maybeId Ptr Rectangle
outInkRect Ptr Rectangle
outLogicalRect
        Rectangle
outInkRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Rsvg.Rectangle.Rectangle) Ptr Rectangle
outInkRect
        Rectangle
outLogicalRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Rsvg.Rectangle.Rectangle) Ptr Rectangle
outLogicalRect
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
        (Rectangle, Rectangle) -> IO (Rectangle, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
outInkRect', Rectangle
outLogicalRect')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
        Ptr Rectangle -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Rectangle
outInkRect
        Ptr Rectangle -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Rectangle
outLogicalRect
     )

#if defined(ENABLE_OVERLOADING)
data HandleGetGeometryForElementMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ((Rsvg.Rectangle.Rectangle, Rsvg.Rectangle.Rectangle))), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetGeometryForElementMethodInfo a signature where
    overloadedMethod = handleGetGeometryForElement

instance O.OverloadedMethodInfo HandleGetGeometryForElementMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetGeometryForElement",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetGeometryForElement"
        })


#endif

-- method Handle::get_geometry_for_layer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"##\" (a single\nhash character), for example, \"##layer1\".  This notation corresponds to a\nURL's fragment ID.  Alternatively, pass %NULL to compute the geometry for the\nwhole SVG."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "viewport"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Viewport size at which the whole SVG would be fitted."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_ink_rect"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Place to store the ink rectangle of the element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_logical_rect"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Place to store the logical rectangle of the element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_get_geometry_for_layer" rsvg_handle_get_geometry_for_layer :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    CString ->                              -- id : TBasicType TUTF8
    Ptr Rsvg.Rectangle.Rectangle ->         -- viewport : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    Ptr Rsvg.Rectangle.Rectangle ->         -- out_ink_rect : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    Ptr Rsvg.Rectangle.Rectangle ->         -- out_logical_rect : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Computes the ink rectangle and logical rectangle of an SVG element, or the
-- whole SVG, as if the whole SVG were rendered to a specific viewport.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- The \"ink rectangle\" is the bounding box that would be painted
-- for fully- stroked and filled elements.
-- 
-- The \"logical rectangle\" just takes into account the unstroked
-- paths and text outlines.
-- 
-- Note that these bounds are not minimum bounds; for example,
-- clipping paths are not taken into account.
-- 
-- You can pass @/NULL/@ for the /@id@/ if you want to measure all
-- the elements in the SVG, i.e. to measure everything from the
-- root element.
-- 
-- This operation is not constant-time, as it involves going through all
-- the child elements.
-- 
-- API ordering: This function must be called on a fully-loaded /@handle@/.  See
-- the section \<ulink url=\"RsvgHandle.html@/API/@-ordering\">API ordering\<\/ulink> for details.
-- 
-- Panics: this function will panic if the /@handle@/ is not fully-loaded.
-- 
-- /Since: 2.46/
handleGetGeometryForLayer ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> Maybe (T.Text)
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"##\" (a single
    -- hash character), for example, \"#@/layer1/@\".  This notation corresponds to a
    -- URL\'s fragment ID.  Alternatively, pass 'P.Nothing' to compute the geometry for the
    -- whole SVG.
    -> Rsvg.Rectangle.Rectangle
    -- ^ /@viewport@/: Viewport size at which the whole SVG would be fitted.
    -> m ((Rsvg.Rectangle.Rectangle, Rsvg.Rectangle.Rectangle))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleGetGeometryForLayer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Maybe Text -> Rectangle -> m (Rectangle, Rectangle)
handleGetGeometryForLayer a
handle Maybe Text
id Rectangle
viewport = IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle))
-> IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    Ptr Rectangle
viewport' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
viewport
    Ptr Rectangle
outInkRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
32 :: IO (Ptr Rsvg.Rectangle.Rectangle)
    Ptr Rectangle
outLogicalRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
32 :: IO (Ptr Rsvg.Rectangle.Rectangle)
    IO (Rectangle, Rectangle) -> IO () -> IO (Rectangle, Rectangle)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle
-> CString
-> Ptr Rectangle
-> Ptr Rectangle
-> Ptr Rectangle
-> Ptr (Ptr GError)
-> IO CInt
rsvg_handle_get_geometry_for_layer Ptr Handle
handle' CString
maybeId Ptr Rectangle
viewport' Ptr Rectangle
outInkRect Ptr Rectangle
outLogicalRect
        Rectangle
outInkRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Rsvg.Rectangle.Rectangle) Ptr Rectangle
outInkRect
        Rectangle
outLogicalRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Rsvg.Rectangle.Rectangle) Ptr Rectangle
outLogicalRect
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
viewport
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
        (Rectangle, Rectangle) -> IO (Rectangle, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
outInkRect', Rectangle
outLogicalRect')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
        Ptr Rectangle -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Rectangle
outInkRect
        Ptr Rectangle -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Rectangle
outLogicalRect
     )

#if defined(ENABLE_OVERLOADING)
data HandleGetGeometryForLayerMethodInfo
instance (signature ~ (Maybe (T.Text) -> Rsvg.Rectangle.Rectangle -> m ((Rsvg.Rectangle.Rectangle, Rsvg.Rectangle.Rectangle))), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetGeometryForLayerMethodInfo a signature where
    overloadedMethod = handleGetGeometryForLayer

instance O.OverloadedMethodInfo HandleGetGeometryForLayerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetGeometryForLayer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetGeometryForLayer"
        })


#endif

-- method Handle::get_intrinsic_dimensions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_has_width"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Will be set to #TRUE if the toplevel SVG has a <literal>width</literal> attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_width"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Length" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Will be set to the value of the <literal>width</literal> attribute in the toplevel SVG"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_has_height"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Will be set to #TRUE if the toplevel SVG has a <literal>height</literal> attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_height"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Length" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Will be set to the value of the <literal>height</literal> attribute in the toplevel SVG"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_has_viewbox"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Will be set to #TRUE if the toplevel SVG has a <literal>viewBox</literal> attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_viewbox"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Will be set to the value of the <literal>viewBox</literal> attribute in the toplevel SVG"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_get_intrinsic_dimensions" rsvg_handle_get_intrinsic_dimensions :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr CInt ->                             -- out_has_width : TBasicType TBoolean
    Ptr Rsvg.Length.Length ->               -- out_width : TInterface (Name {namespace = "Rsvg", name = "Length"})
    Ptr CInt ->                             -- out_has_height : TBasicType TBoolean
    Ptr Rsvg.Length.Length ->               -- out_height : TInterface (Name {namespace = "Rsvg", name = "Length"})
    Ptr CInt ->                             -- out_has_viewbox : TBasicType TBoolean
    Ptr Rsvg.Rectangle.Rectangle ->         -- out_viewbox : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    IO ()

-- | Queries the \<literal>width\<\/literal>, \<literal>height\<\/literal>, and
-- \<literal>viewBox\<\/literal> attributes in an SVG document.
-- 
-- If you are calling this function to compute a scaling factor to render the SVG,
-- consider simply using 'GI.Rsvg.Objects.Handle.handleRenderDocument' instead; it will do the
-- scaling computations automatically.
-- 
-- As an example, the following SVG element has a \<literal>width\<\/literal> of 100 pixels and a \<literal>height\<\/literal> of 400 pixels, but no \<literal>viewBox\<\/literal>:
-- 
-- >
-- ><svg xmlns="http://www.w3.org/2000/svg" width="100" height="400">
-- 
-- 
-- Conversely, the following element has a \<literal>viewBox\<\/literal>, but no \<literal>width\<\/literal> or \<literal>height\<\/literal>:
-- 
-- >
-- ><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 100 400">
-- 
-- 
-- Note that the t'GI.Rsvg.Structs.Length.Length' return values have @/RsvgUnits/@ in them; you should
-- not assume that they are always in pixels.  For example, the following SVG element
-- will return a width value whose \<literal>units\<\/literal> field is RSVG_UNIT_MM.
-- 
-- >
-- ><svg xmlns="http://www.w3.org/2000/svg" width="210mm" height="297mm">
-- 
-- 
-- API ordering: This function must be called on a fully-loaded /@handle@/.  See
-- the section \<ulink url=\"RsvgHandle.html@/API/@-ordering\">API ordering\<\/ulink> for details.
-- 
-- Panics: this function will panic if the /@handle@/ is not fully-loaded.
-- 
-- /Since: 2.46/
handleGetIntrinsicDimensions ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> m ((Bool, Rsvg.Length.Length, Bool, Rsvg.Length.Length, Bool, Rsvg.Rectangle.Rectangle))
handleGetIntrinsicDimensions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> m (Bool, Length, Bool, Length, Bool, Rectangle)
handleGetIntrinsicDimensions a
handle = IO (Bool, Length, Bool, Length, Bool, Rectangle)
-> m (Bool, Length, Bool, Length, Bool, Rectangle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Length, Bool, Length, Bool, Rectangle)
 -> m (Bool, Length, Bool, Length, Bool, Rectangle))
-> IO (Bool, Length, Bool, Length, Bool, Rectangle)
-> m (Bool, Length, Bool, Length, Bool, Rectangle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr CInt
outHasWidth <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Length
outWidth <- Int -> IO (Ptr Length)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Rsvg.Length.Length)
    Ptr CInt
outHasHeight <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Length
outHeight <- Int -> IO (Ptr Length)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Rsvg.Length.Length)
    Ptr CInt
outHasViewbox <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Rectangle
outViewbox <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
32 :: IO (Ptr Rsvg.Rectangle.Rectangle)
    Ptr Handle
-> Ptr CInt
-> Ptr Length
-> Ptr CInt
-> Ptr Length
-> Ptr CInt
-> Ptr Rectangle
-> IO ()
rsvg_handle_get_intrinsic_dimensions Ptr Handle
handle' Ptr CInt
outHasWidth Ptr Length
outWidth Ptr CInt
outHasHeight Ptr Length
outHeight Ptr CInt
outHasViewbox Ptr Rectangle
outViewbox
    CInt
outHasWidth' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outHasWidth
    let outHasWidth'' :: Bool
outHasWidth'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
outHasWidth'
    Length
outWidth' <- ((ManagedPtr Length -> Length) -> Ptr Length -> IO Length
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Length -> Length
Rsvg.Length.Length) Ptr Length
outWidth
    CInt
outHasHeight' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outHasHeight
    let outHasHeight'' :: Bool
outHasHeight'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
outHasHeight'
    Length
outHeight' <- ((ManagedPtr Length -> Length) -> Ptr Length -> IO Length
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Length -> Length
Rsvg.Length.Length) Ptr Length
outHeight
    CInt
outHasViewbox' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outHasViewbox
    let outHasViewbox'' :: Bool
outHasViewbox'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
outHasViewbox'
    Rectangle
outViewbox' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Rsvg.Rectangle.Rectangle) Ptr Rectangle
outViewbox
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outHasWidth
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outHasHeight
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outHasViewbox
    (Bool, Length, Bool, Length, Bool, Rectangle)
-> IO (Bool, Length, Bool, Length, Bool, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
outHasWidth'', Length
outWidth', Bool
outHasHeight'', Length
outHeight', Bool
outHasViewbox'', Rectangle
outViewbox')

#if defined(ENABLE_OVERLOADING)
data HandleGetIntrinsicDimensionsMethodInfo
instance (signature ~ (m ((Bool, Rsvg.Length.Length, Bool, Rsvg.Length.Length, Bool, Rsvg.Rectangle.Rectangle))), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetIntrinsicDimensionsMethodInfo a signature where
    overloadedMethod = handleGetIntrinsicDimensions

instance O.OverloadedMethodInfo HandleGetIntrinsicDimensionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetIntrinsicDimensions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetIntrinsicDimensions"
        })


#endif

-- method Handle::get_intrinsic_size_in_pixels
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_width"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Will be set to the computed width; you should round this up to get integer pixels."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_height"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Will be set to the computed height; you should round this up to get integer pixels."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_get_intrinsic_size_in_pixels" rsvg_handle_get_intrinsic_size_in_pixels :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr CDouble ->                          -- out_width : TBasicType TDouble
    Ptr CDouble ->                          -- out_height : TBasicType TDouble
    IO CInt

-- | Converts an SVG document\'s intrinsic dimensions to pixels, and returns the result.
-- 
-- This function is able to extract the size in pixels from an SVG document if the
-- document has both \<literal>width\<\/literal> and \<literal>height\<\/literal> attributes
-- with physical units (px, in, cm, mm, pt, pc) or font-based units (em, ex).  For
-- physical units, the dimensions are normalized to pixels using the dots-per-inch (DPI)
-- value set previously with 'GI.Rsvg.Objects.Handle.handleSetDpi'.  For font-based units, this function
-- uses the computed value of the @font-size@ property for the toplevel
-- \<literal>&lt;svg&gt;\<\/literal> element.  In those cases, this function returns 'P.True'.
-- 
-- This function is not able to extract the size in pixels directly from the intrinsic
-- dimensions of the SVG document if the \<literal>width\<\/literal> or
-- \<literal>height\<\/literal> are in percentage units (or if they do not exist, in which
-- case the SVG spec mandates that they default to 100%), as these require a
-- \<firstterm>viewport\<\/firstterm> to be resolved to a final size.  In this case, the
-- function returns 'P.False'.
-- 
-- For example, the following document fragment has intrinsic dimensions that will resolve
-- to 20x30 pixels.
-- 
-- >
-- ><svg xmlns="http://www.w3.org/2000/svg" width="20" height="30"/>
-- 
-- 
-- Similarly, if the DPI is set to 96, this document will resolve to 192x288 pixels (i.e. 96*2 x 96*3).
-- 
-- >
-- ><svg xmlns="http://www.w3.org/2000/svg" width="2in" height="3in"/>
-- 
-- 
-- The dimensions of the following documents cannot be resolved to pixels directly, and
-- this function would return 'P.False' for them:
-- 
-- >
-- ><!-- Needs a viewport against which to compute the percentages. -->
-- ><svg xmlns="http://www.w3.org/2000/svg" width="100%" height="100%"/>
-- >
-- ><!-- Does not have intrinsic width/height, just a 1:2 aspect ratio which
-- >     needs to be fitted within a viewport. -->
-- ><svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 100 200"/>
-- 
-- 
-- Instead of querying an SVG document\'s size, applications are encouraged to render SVG
-- documents to a size chosen by the application, by passing a suitably-sized viewport to
-- 'GI.Rsvg.Objects.Handle.handleRenderDocument'.
-- 
-- /Since: 2.52/
handleGetIntrinsicSizeInPixels ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> m ((Bool, Double, Double))
    -- ^ __Returns:__ 'P.True' if the dimensions could be converted directly to pixels; in this case
    -- /@outWidth@/ and /@outHeight@/ will be set accordingly.  Note that the dimensions are
    -- floating-point numbers, so your application can know the exact size of an SVG document.
    -- To get integer dimensions, you should use @ceil()@ to round up to the nearest integer
    -- (just using @round()@, may may chop off pixels with fractional coverage).  If the
    -- dimensions cannot be converted to pixels, returns 'P.False' and puts 0.0 in both
    -- /@outWidth@/ and /@outHeight@/.
handleGetIntrinsicSizeInPixels :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> m (Bool, Double, Double)
handleGetIntrinsicSizeInPixels a
handle = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double) -> m (Bool, Double, Double))
-> IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr CDouble
outWidth <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
outHeight <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Handle -> Ptr CDouble -> Ptr CDouble -> IO CInt
rsvg_handle_get_intrinsic_size_in_pixels Ptr Handle
handle' Ptr CDouble
outWidth Ptr CDouble
outHeight
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
outWidth' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
outWidth
    let outWidth'' :: Double
outWidth'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
outWidth'
    CDouble
outHeight' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
outHeight
    let outHeight'' :: Double
outHeight'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
outHeight'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
outWidth
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
outHeight
    (Bool, Double, Double) -> IO (Bool, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
outWidth'', Double
outHeight'')

#if defined(ENABLE_OVERLOADING)
data HandleGetIntrinsicSizeInPixelsMethodInfo
instance (signature ~ (m ((Bool, Double, Double))), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetIntrinsicSizeInPixelsMethodInfo a signature where
    overloadedMethod = handleGetIntrinsicSizeInPixels

instance O.OverloadedMethodInfo HandleGetIntrinsicSizeInPixelsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetIntrinsicSizeInPixels",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetIntrinsicSizeInPixels"
        })


#endif

-- method Handle::get_pixbuf
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_get_pixbuf" rsvg_handle_get_pixbuf :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Returns the pixbuf loaded by /@handle@/.  The pixbuf returned will be reffed, so
-- the caller of this function must assume that ref.
-- 
-- API ordering: This function must be called on a fully-loaded /@handle@/.  See
-- the section \<ulink url=\"RsvgHandle.html@/API/@-ordering\">API ordering\<\/ulink> for details.
-- 
-- This function depends on the t'GI.Rsvg.Objects.Handle.Handle'\'s dots-per-inch value (DPI) to compute the
-- \"natural size\" of the document in pixels, so you should call 'GI.Rsvg.Objects.Handle.handleSetDpi'
-- beforehand.
handleGetPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ a pixbuf, or 'P.Nothing' if an error occurs
    -- during rendering.
handleGetPixbuf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> m (Maybe Pixbuf)
handleGetPixbuf a
handle = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr Pixbuf
result <- Ptr Handle -> IO (Ptr Pixbuf)
rsvg_handle_get_pixbuf Ptr Handle
handle'
    Maybe Pixbuf
maybeResult <- Ptr Pixbuf -> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pixbuf
result ((Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf))
-> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
result' -> do
        Pixbuf
result'' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result'
        Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    Maybe Pixbuf -> IO (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
maybeResult

#if defined(ENABLE_OVERLOADING)
data HandleGetPixbufMethodInfo
instance (signature ~ (m (Maybe GdkPixbuf.Pixbuf.Pixbuf)), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetPixbufMethodInfo a signature where
    overloadedMethod = handleGetPixbuf

instance O.OverloadedMethodInfo HandleGetPixbufMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetPixbuf",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetPixbuf"
        })


#endif

-- method Handle::get_pixbuf_sub
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"#\" (a single\nhash character), for example, \"##layer1\".  This notation corresponds to a\nURL's fragment ID.  Alternatively, pass %NULL to use the whole SVG."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_get_pixbuf_sub" rsvg_handle_get_pixbuf_sub :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    CString ->                              -- id : TBasicType TUTF8
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Creates a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' the same size as the entire SVG loaded into /@handle@/, but
-- only renders the sub-element that has the specified /@id@/ (and all its
-- sub-sub-elements recursively).  If /@id@/ is @/NULL/@, this function renders the
-- whole SVG.
-- 
-- This function depends on the t'GI.Rsvg.Objects.Handle.Handle'\'s dots-per-inch value (DPI) to compute the
-- \"natural size\" of the document in pixels, so you should call 'GI.Rsvg.Objects.Handle.handleSetDpi'
-- beforehand.
-- 
-- If you need to render an image which is only big enough to fit a particular
-- sub-element of the SVG, consider using 'GI.Rsvg.Objects.Handle.handleRenderElement'.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- API ordering: This function must be called on a fully-loaded /@handle@/.  See
-- the section \<ulink url=\"RsvgHandle.html@/API/@-ordering\">API ordering\<\/ulink> for details.
-- 
-- /Since: 2.14/
handleGetPixbufSub ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> Maybe (T.Text)
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"#\" (a single
    -- hash character), for example, \"#@/layer1/@\".  This notation corresponds to a
    -- URL\'s fragment ID.  Alternatively, pass 'P.Nothing' to use the whole SVG.
    -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ a pixbuf, or 'P.Nothing' if an error occurs
    -- during rendering.
handleGetPixbufSub :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Maybe Text -> m (Maybe Pixbuf)
handleGetPixbufSub a
handle Maybe Text
id = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    Ptr Pixbuf
result <- Ptr Handle -> CString -> IO (Ptr Pixbuf)
rsvg_handle_get_pixbuf_sub Ptr Handle
handle' CString
maybeId
    Maybe Pixbuf
maybeResult <- Ptr Pixbuf -> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pixbuf
result ((Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf))
-> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
result' -> do
        Pixbuf
result'' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result'
        Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
    Maybe Pixbuf -> IO (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
maybeResult

#if defined(ENABLE_OVERLOADING)
data HandleGetPixbufSubMethodInfo
instance (signature ~ (Maybe (T.Text) -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetPixbufSubMethodInfo a signature where
    overloadedMethod = handleGetPixbufSub

instance O.OverloadedMethodInfo HandleGetPixbufSubMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetPixbufSub",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetPixbufSub"
        })


#endif

-- method Handle::get_position_sub
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position_data"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "PositionData" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A place to store the SVG fragment's position."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"#\" (a single\nhash character), for example, \"##layer1\".  This notation corresponds to a\nURL's fragment ID.  Alternatively, pass %NULL to use the whole SVG."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_get_position_sub" rsvg_handle_get_position_sub :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Rsvg.PositionData.PositionData ->   -- position_data : TInterface (Name {namespace = "Rsvg", name = "PositionData"})
    CString ->                              -- id : TBasicType TUTF8
    IO CInt

{-# DEPRECATED handleGetPositionSub ["(Since version 2.46.)","Use 'GI.Rsvg.Objects.Handle.handleGetGeometryForLayer' instead.  This function is","deprecated since it is not able to return exact floating-point positions, only integer","pixels."] #-}
-- | Get the position of a subelement of the SVG file. Do not call from within
-- the size_func callback, because an infinite loop will occur.
-- 
-- This function depends on the t'GI.Rsvg.Objects.Handle.Handle'\'s DPI to compute dimensions in
-- pixels, so you should call 'GI.Rsvg.Objects.Handle.handleSetDpi' beforehand.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- /Since: 2.22/
handleGetPositionSub ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: A t'GI.Rsvg.Objects.Handle.Handle'
    -> Maybe (T.Text)
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"#\" (a single
    -- hash character), for example, \"#@/layer1/@\".  This notation corresponds to a
    -- URL\'s fragment ID.  Alternatively, pass 'P.Nothing' to use the whole SVG.
    -> m ((Bool, Rsvg.PositionData.PositionData))
handleGetPositionSub :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Maybe Text -> m (Bool, PositionData)
handleGetPositionSub a
handle Maybe Text
id = IO (Bool, PositionData) -> m (Bool, PositionData)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, PositionData) -> m (Bool, PositionData))
-> IO (Bool, PositionData) -> m (Bool, PositionData)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr PositionData
positionData <- Int -> IO (Ptr PositionData)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
8 :: IO (Ptr Rsvg.PositionData.PositionData)
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    CInt
result <- Ptr Handle -> Ptr PositionData -> CString -> IO CInt
rsvg_handle_get_position_sub Ptr Handle
handle' Ptr PositionData
positionData CString
maybeId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    PositionData
positionData' <- ((ManagedPtr PositionData -> PositionData)
-> Ptr PositionData -> IO PositionData
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr PositionData -> PositionData
Rsvg.PositionData.PositionData) Ptr PositionData
positionData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
    (Bool, PositionData) -> IO (Bool, PositionData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', PositionData
positionData')

#if defined(ENABLE_OVERLOADING)
data HandleGetPositionSubMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ((Bool, Rsvg.PositionData.PositionData))), MonadIO m, IsHandle a) => O.OverloadedMethod HandleGetPositionSubMethodInfo a signature where
    overloadedMethod = handleGetPositionSub

instance O.OverloadedMethodInfo HandleGetPositionSubMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleGetPositionSub",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleGetPositionSub"
        })


#endif

-- method Handle::has_sub
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"#\" (a single hash\ncharacter), for example, \"##layer1\".  This notation corresponds to a URL's\nfragment ID."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_has_sub" rsvg_handle_has_sub :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    CString ->                              -- id : TBasicType TUTF8
    IO CInt

-- | Checks whether the element /@id@/ exists in the SVG document.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- /Since: 2.22/
handleHasSub ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: a t'GI.Rsvg.Objects.Handle.Handle'
    -> T.Text
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"#\" (a single hash
    -- character), for example, \"#@/layer1/@\".  This notation corresponds to a URL\'s
    -- fragment ID.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@id@/ exists in the SVG document, 'P.False' otherwise.
handleHasSub :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Text -> m Bool
handleHasSub a
handle Text
id = IO Bool -> m Bool
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 Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    CString
id' <- Text -> IO CString
textToCString Text
id
    CInt
result <- Ptr Handle -> CString -> IO CInt
rsvg_handle_has_sub Ptr Handle
handle' CString
id'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HandleHasSubMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsHandle a) => O.OverloadedMethod HandleHasSubMethodInfo a signature where
    overloadedMethod = handleHasSub

instance O.OverloadedMethodInfo HandleHasSubMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleHasSub",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleHasSub"
        })


#endif

-- method Handle::internal_set_testing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "testing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether to enable testing mode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_internal_set_testing" rsvg_handle_internal_set_testing :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    CInt ->                                 -- testing : TBasicType TBoolean
    IO ()

-- | Do not call this function.  This is intended for librsvg\'s internal
-- test suite only.
handleInternalSetTesting ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: a t'GI.Rsvg.Objects.Handle.Handle'
    -> Bool
    -- ^ /@testing@/: Whether to enable testing mode
    -> m ()
handleInternalSetTesting :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Bool -> m ()
handleInternalSetTesting a
handle Bool
testing = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    let testing' :: CInt
testing' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
testing
    Ptr Handle -> CInt -> IO ()
rsvg_handle_internal_set_testing Ptr Handle
handle' CInt
testing'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HandleInternalSetTestingMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleInternalSetTestingMethodInfo a signature where
    overloadedMethod = handleInternalSetTesting

instance O.OverloadedMethodInfo HandleInternalSetTestingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleInternalSetTesting",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleInternalSetTesting"
        })


#endif

-- method Handle::read_stream_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInputStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_read_stream_sync" rsvg_handle_read_stream_sync :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Gio.InputStream.InputStream ->      -- stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Reads /@stream@/ and writes the data from it to /@handle@/.
-- 
-- Before calling this function, you may need to call 'GI.Rsvg.Objects.Handle.handleSetBaseUri'
-- or 'GI.Rsvg.Objects.Handle.handleSetBaseGfile' to set the \"base file\" for resolving
-- references to external resources.  SVG elements like
-- \<literal>&lt;image&gt;\<\/literal> which reference external resources will be
-- resolved relative to the location you specify with those functions.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- /Since: 2.32/
handleReadStreamSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@handle@/: a t'GI.Rsvg.Objects.Handle.Handle'
    -> b
    -- ^ /@stream@/: a t'GI.Gio.Objects.InputStream.InputStream'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleReadStreamSync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsHandle a, IsInputStream b,
 IsCancellable c) =>
a -> b -> Maybe c -> m ()
handleReadStreamSync a
handle b
stream Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr InputStream
stream' <- b -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
stream
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle
-> Ptr InputStream
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
rsvg_handle_read_stream_sync Ptr Handle
handle' Ptr InputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
stream
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data HandleReadStreamSyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsHandle a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod HandleReadStreamSyncMethodInfo a signature where
    overloadedMethod = handleReadStreamSync

instance O.OverloadedMethodInfo HandleReadStreamSyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleReadStreamSync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleReadStreamSync"
        })


#endif

-- method Handle::render_cairo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_render_cairo" rsvg_handle_render_cairo :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    IO CInt

{-# DEPRECATED handleRenderCairo ["(Since version 2.52.)","Please use 'GI.Rsvg.Objects.Handle.handleRenderDocument' instead; that function lets","you pass a viewport and obtain a good error message."] #-}
-- | Draws a loaded SVG handle to a Cairo context.  Please try to use
-- 'GI.Rsvg.Objects.Handle.handleRenderDocument' instead, which allows you to pick the size
-- at which the document will be rendered.
-- 
-- Historically this function has picked a size by itself, based on the following rules:
-- 
-- \<itemizedlist>
--   \<listitem>
--     If the SVG document has both \<literal>width\<\/literal> and \<literal>height\<\/literal>
--     attributes with physical units (px, in, cm, mm, pt, pc) or font-based units (em,
--     ex), the function computes the size directly based on the dots-per-inch (DPI) you
--     have configured with 'GI.Rsvg.Objects.Handle.handleSetDpi'.  This is the same approach as
--     'GI.Rsvg.Objects.Handle.handleGetIntrinsicSizeInPixels'.
--   \<\/listitem>
--   \<listitem>
--     Otherwise, if there is a \<literal>viewBox\<\/literal> attribute and both
--     \<literal>width\<\/literal> and \<literal>height\<\/literal> are set to
--     \<literal>100%\<\/literal> (or if they don\'t exist at all and thus default to 100%),
--     the function uses the width and height of the viewBox as a pixel size.  This
--     produces a rendered document with the correct aspect ratio.
--   \<\/listitem>
--   \<listitem>
--      Otherwise, this function computes the extents of every graphical object in the SVG
--      document to find the total extents.  This is moderately expensive, but no more expensive
--      than rendering the whole document, for example.
--   \<\/listitem>
--   \<listitem>
--     This function cannot deal with percentage-based units for \<literal>width\<\/literal>
--     and \<literal>height\<\/literal> because there is no viewport against which they could
--     be resolved; that is why it will compute the extents of objects in that case.  This
--     is why we recommend that you use 'GI.Rsvg.Objects.Handle.handleRenderDocument' instead, which takes
--     in a viewport and follows the sizing policy from the web platform.
--   \<\/listitem>
-- \<\/itemizedlist>
-- 
-- Drawing will occur with respect to the /@cr@/\'s current transformation: for example, if
-- the /@cr@/ has a rotated current transformation matrix, the whole SVG will be rotated in
-- the rendered version.
-- 
-- This function depends on the t'GI.Rsvg.Objects.Handle.Handle'\'s DPI to compute dimensions in
-- pixels, so you should call 'GI.Rsvg.Objects.Handle.handleSetDpi' beforehand.
-- 
-- Note that /@cr@/ must be a Cairo context that is not in an error state, that is,
-- @/cairo_status()/@ must return @/CAIRO_STATUS_SUCCESS/@ for it.  Cairo can set a
-- context to be in an error state in various situations, for example, if it was
-- passed an invalid matrix or if it was created for an invalid surface.
-- 
-- /Since: 2.14/
handleRenderCairo ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: A t'GI.Rsvg.Objects.Handle.Handle'
    -> Cairo.Context.Context
    -- ^ /@cr@/: A Cairo context
    -> m Bool
    -- ^ __Returns:__ 'P.True' if drawing succeeded; 'P.False' otherwise.
handleRenderCairo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Context -> m Bool
handleRenderCairo a
handle Context
cr = IO Bool -> m Bool
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 Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    CInt
result <- Ptr Handle -> Ptr Context -> IO CInt
rsvg_handle_render_cairo Ptr Handle
handle' Ptr Context
cr'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HandleRenderCairoMethodInfo
instance (signature ~ (Cairo.Context.Context -> m Bool), MonadIO m, IsHandle a) => O.OverloadedMethod HandleRenderCairoMethodInfo a signature where
    overloadedMethod = handleRenderCairo

instance O.OverloadedMethodInfo HandleRenderCairoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleRenderCairo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleRenderCairo"
        })


#endif

-- method Handle::render_cairo_sub
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"##\" (a single\nhash character), for example, \"##layer1\".  This notation corresponds to a\nURL's fragment ID.  Alternatively, pass %NULL to render the whole SVG."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_render_cairo_sub" rsvg_handle_render_cairo_sub :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    CString ->                              -- id : TBasicType TUTF8
    IO CInt

{-# DEPRECATED handleRenderCairoSub ["(Since version 2.52.)","Please use 'GI.Rsvg.Objects.Handle.handleRenderLayer' instead; that function lets","you pass a viewport and obtain a good error message."] #-}
-- | Renders a single SVG element in the same place as for a whole SVG document (a \"subset\"
-- of the document).  Please try to use 'GI.Rsvg.Objects.Handle.handleRenderLayer' instead, which allows
-- you to pick the size at which the document with the layer will be rendered.
-- 
-- This is equivalent to 'GI.Rsvg.Objects.Handle.handleRenderCairo', but it renders only a single
-- element and its children, as if they composed an individual layer in the SVG.
-- 
-- Historically this function has picked a size for the whole document by itself, based
-- on the following rules:
-- 
-- \<itemizedlist>
--   \<listitem>
--     If the SVG document has both \<literal>width\<\/literal> and \<literal>height\<\/literal>
--     attributes with physical units (px, in, cm, mm, pt, pc) or font-based units (em,
--     ex), the function computes the size directly based on the dots-per-inch (DPI) you
--     have configured with 'GI.Rsvg.Objects.Handle.handleSetDpi'.  This is the same approach as
--     'GI.Rsvg.Objects.Handle.handleGetIntrinsicSizeInPixels'.
--   \<\/listitem>
--   \<listitem>
--     Otherwise, if there is a \<literal>viewBox\<\/literal> attribute and both
--     \<literal>width\<\/literal> and \<literal>height\<\/literal> are set to
--     \<literal>100%\<\/literal> (or if they don\'t exist at all and thus default to 100%),
--     the function uses the width and height of the viewBox as a pixel size.  This
--     produces a rendered document with the correct aspect ratio.
--   \<\/listitem>
--   \<listitem>
--     Otherwise, this function computes the extents of every graphical object in the SVG
--     document to find the total extents.  This is moderately expensive, but no more expensive
--     than rendering the whole document, for example.
--   \<\/listitem>
--   \<listitem>
--     This function cannot deal with percentage-based units for \<literal>width\<\/literal>
--     and \<literal>height\<\/literal> because there is no viewport against which they could
--     be resolved; that is why it will compute the extents of objects in that case.  This
--     is why we recommend that you use 'GI.Rsvg.Objects.Handle.handleRenderLayer' instead, which takes
--     in a viewport and follows the sizing policy from the web platform.
--   \<\/listitem>
-- \<\/itemizedlist>
-- 
-- Drawing will occur with respect to the /@cr@/\'s current transformation: for example, if
-- the /@cr@/ has a rotated current transformation matrix, the whole SVG will be rotated in
-- the rendered version.
-- 
-- This function depends on the t'GI.Rsvg.Objects.Handle.Handle'\'s DPI to compute dimensions in
-- pixels, so you should call 'GI.Rsvg.Objects.Handle.handleSetDpi' beforehand.
-- 
-- Note that /@cr@/ must be a Cairo context that is not in an error state, that is,
-- @/cairo_status()/@ must return @/CAIRO_STATUS_SUCCESS/@ for it.  Cairo can set a
-- context to be in an error state in various situations, for example, if it was
-- passed an invalid matrix or if it was created for an invalid surface.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- /Since: 2.14/
handleRenderCairoSub ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: A t'GI.Rsvg.Objects.Handle.Handle'
    -> Cairo.Context.Context
    -- ^ /@cr@/: A Cairo context
    -> Maybe (T.Text)
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"##\" (a single
    -- hash character), for example, \"#@/layer1/@\".  This notation corresponds to a
    -- URL\'s fragment ID.  Alternatively, pass 'P.Nothing' to render the whole SVG.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if drawing succeeded; 'P.False' otherwise.
handleRenderCairoSub :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Context -> Maybe Text -> m Bool
handleRenderCairoSub a
handle Context
cr Maybe Text
id = IO Bool -> m Bool
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 Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    CInt
result <- Ptr Handle -> Ptr Context -> CString -> IO CInt
rsvg_handle_render_cairo_sub Ptr Handle
handle' Ptr Context
cr' CString
maybeId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HandleRenderCairoSubMethodInfo
instance (signature ~ (Cairo.Context.Context -> Maybe (T.Text) -> m Bool), MonadIO m, IsHandle a) => O.OverloadedMethod HandleRenderCairoSubMethodInfo a signature where
    overloadedMethod = handleRenderCairoSub

instance O.OverloadedMethodInfo HandleRenderCairoSubMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleRenderCairoSub",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleRenderCairoSub"
        })


#endif

-- method Handle::render_document
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "viewport"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Viewport size at which the whole SVG would be fitted."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_render_document" rsvg_handle_render_document :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    Ptr Rsvg.Rectangle.Rectangle ->         -- viewport : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Renders the whole SVG document fitted to a viewport.
-- 
-- The /@viewport@/ gives the position and size at which the whole SVG document will be
-- rendered.  The document is scaled proportionally to fit into this viewport.
-- 
-- The /@cr@/ must be in a @/CAIRO_STATUS_SUCCESS/@ state, or this function will not
-- render anything, and instead will return an error.
-- 
-- API ordering: This function must be called on a fully-loaded /@handle@/.  See
-- the section \<ulink url=\"RsvgHandle.html@/API/@-ordering\">API ordering\<\/ulink> for details.
-- 
-- Panics: this function will panic if the /@handle@/ is not fully-loaded.
-- 
-- /Since: 2.46/
handleRenderDocument ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> Cairo.Context.Context
    -- ^ /@cr@/: A Cairo context
    -> Rsvg.Rectangle.Rectangle
    -- ^ /@viewport@/: Viewport size at which the whole SVG would be fitted.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleRenderDocument :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Context -> Rectangle -> m ()
handleRenderDocument a
handle Context
cr Rectangle
viewport = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr Rectangle
viewport' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
viewport
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle
-> Ptr Context -> Ptr Rectangle -> Ptr (Ptr GError) -> IO CInt
rsvg_handle_render_document Ptr Handle
handle' Ptr Context
cr' Ptr Rectangle
viewport'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
        Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
viewport
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data HandleRenderDocumentMethodInfo
instance (signature ~ (Cairo.Context.Context -> Rsvg.Rectangle.Rectangle -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleRenderDocumentMethodInfo a signature where
    overloadedMethod = handleRenderDocument

instance O.OverloadedMethodInfo HandleRenderDocumentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleRenderDocument",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleRenderDocument"
        })


#endif

-- method Handle::render_element
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"##\" (a single\nhash character), for example, \"##layer1\".  This notation corresponds to a\nURL's fragment ID.  Alternatively, pass %NULL to render the whole SVG document tree."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "element_viewport"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Viewport size in which to fit the element"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_render_element" rsvg_handle_render_element :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    CString ->                              -- id : TBasicType TUTF8
    Ptr Rsvg.Rectangle.Rectangle ->         -- element_viewport : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Renders a single SVG element to a given viewport
-- 
-- This function can be used to extract individual element subtrees and render them,
-- scaled to a given /@elementViewport@/.  This is useful for applications which have
-- reusable objects in an SVG and want to render them individually; for example, an
-- SVG full of icons that are meant to be be rendered independently of each other.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- You can pass @/NULL/@ for the /@id@/ if you want to render all
-- the elements in the SVG, i.e. to render everything from the
-- root element.
-- 
-- The @element_viewport@ gives the position and size at which the named element will
-- be rendered.  FIXME: mention proportional scaling.
-- 
-- API ordering: This function must be called on a fully-loaded /@handle@/.  See
-- the section \<ulink url=\"RsvgHandle.html@/API/@-ordering\">API ordering\<\/ulink> for details.
-- 
-- Panics: this function will panic if the /@handle@/ is not fully-loaded.
-- 
-- /Since: 2.46/
handleRenderElement ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> Cairo.Context.Context
    -- ^ /@cr@/: A Cairo context
    -> Maybe (T.Text)
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"##\" (a single
    -- hash character), for example, \"#@/layer1/@\".  This notation corresponds to a
    -- URL\'s fragment ID.  Alternatively, pass 'P.Nothing' to render the whole SVG document tree.
    -> Rsvg.Rectangle.Rectangle
    -- ^ /@elementViewport@/: Viewport size in which to fit the element
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleRenderElement :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Context -> Maybe Text -> Rectangle -> m ()
handleRenderElement a
handle Context
cr Maybe Text
id Rectangle
elementViewport = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    Ptr Rectangle
elementViewport' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
elementViewport
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle
-> Ptr Context
-> CString
-> Ptr Rectangle
-> Ptr (Ptr GError)
-> IO CInt
rsvg_handle_render_element Ptr Handle
handle' Ptr Context
cr' CString
maybeId Ptr Rectangle
elementViewport'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
        Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
elementViewport
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
     )

#if defined(ENABLE_OVERLOADING)
data HandleRenderElementMethodInfo
instance (signature ~ (Cairo.Context.Context -> Maybe (T.Text) -> Rsvg.Rectangle.Rectangle -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleRenderElementMethodInfo a signature where
    overloadedMethod = handleRenderElement

instance O.OverloadedMethodInfo HandleRenderElementMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleRenderElement",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleRenderElement"
        })


#endif

-- method Handle::render_layer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element's id within the SVG, starting with \"##\" (a single\nhash character), for example, \"##layer1\".  This notation corresponds to a\nURL's fragment ID.  Alternatively, pass %NULL to render the whole SVG document tree."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "viewport"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Viewport size at which the whole SVG would be fitted."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_render_layer" rsvg_handle_render_layer :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    CString ->                              -- id : TBasicType TUTF8
    Ptr Rsvg.Rectangle.Rectangle ->         -- viewport : TInterface (Name {namespace = "Rsvg", name = "Rectangle"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Renders a single SVG element in the same place as for a whole SVG document.
-- 
-- The /@viewport@/ gives the position and size at which the whole SVG document would be
-- rendered.  The document is scaled proportionally to fit into this viewport; hence the
-- individual layer may be smaller than this.
-- 
-- This is equivalent to 'GI.Rsvg.Objects.Handle.handleRenderDocument', but it renders only a
-- single element and its children, as if they composed an individual layer in
-- the SVG.  The element is rendered with the same transformation matrix as it
-- has within the whole SVG document.  Applications can use this to re-render a
-- single element and repaint it on top of a previously-rendered document, for
-- example.
-- 
-- Element IDs should look like an URL fragment identifier; for example, pass
-- \"#@/foo/@\" (hash \<literal>foo\<\/literal>) to get the geometry of the element that
-- has an \<literal>id=\"foo\"\<\/literal> attribute.
-- 
-- You can pass @/NULL/@ for the /@id@/ if you want to render all
-- the elements in the SVG, i.e. to render everything from the
-- root element.
-- 
-- API ordering: This function must be called on a fully-loaded /@handle@/.  See
-- the section \<ulink url=\"RsvgHandle.html@/API/@-ordering\">API ordering\<\/ulink> for details.
-- 
-- Panics: this function will panic if the /@handle@/ is not fully-loaded.
-- 
-- /Since: 2.46/
handleRenderLayer ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> Cairo.Context.Context
    -- ^ /@cr@/: A Cairo context
    -> Maybe (T.Text)
    -- ^ /@id@/: An element\'s id within the SVG, starting with \"##\" (a single
    -- hash character), for example, \"#@/layer1/@\".  This notation corresponds to a
    -- URL\'s fragment ID.  Alternatively, pass 'P.Nothing' to render the whole SVG document tree.
    -> Rsvg.Rectangle.Rectangle
    -- ^ /@viewport@/: Viewport size at which the whole SVG would be fitted.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleRenderLayer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Context -> Maybe Text -> Rectangle -> m ()
handleRenderLayer a
handle Context
cr Maybe Text
id Rectangle
viewport = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    Ptr Rectangle
viewport' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
viewport
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle
-> Ptr Context
-> CString
-> Ptr Rectangle
-> Ptr (Ptr GError)
-> IO CInt
rsvg_handle_render_layer Ptr Handle
handle' Ptr Context
cr' CString
maybeId Ptr Rectangle
viewport'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
        Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
viewport
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
     )

#if defined(ENABLE_OVERLOADING)
data HandleRenderLayerMethodInfo
instance (signature ~ (Cairo.Context.Context -> Maybe (T.Text) -> Rsvg.Rectangle.Rectangle -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleRenderLayerMethodInfo a signature where
    overloadedMethod = handleRenderLayer

instance O.OverloadedMethodInfo HandleRenderLayerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleRenderLayer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleRenderLayer"
        })


#endif

-- method Handle::set_base_gfile
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "base_file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_set_base_gfile" rsvg_handle_set_base_gfile :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Gio.File.File ->                    -- base_file : TInterface (Name {namespace = "Gio", name = "File"})
    IO ()

-- | Set the base URI for /@handle@/ from /@file@/.
-- 
-- Note: This function may only be called before 'GI.Rsvg.Objects.Handle.handleWrite' or
-- 'GI.Rsvg.Objects.Handle.handleReadStreamSync' have been called.
-- 
-- /Since: 2.32/
handleSetBaseGfile ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a, Gio.File.IsFile b) =>
    a
    -- ^ /@handle@/: a t'GI.Rsvg.Objects.Handle.Handle'
    -> b
    -- ^ /@baseFile@/: a t'GI.Gio.Interfaces.File.File'
    -> m ()
handleSetBaseGfile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsHandle a, IsFile b) =>
a -> b -> m ()
handleSetBaseGfile a
handle b
baseFile = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr File
baseFile' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
baseFile
    Ptr Handle -> Ptr File -> IO ()
rsvg_handle_set_base_gfile Ptr Handle
handle' Ptr File
baseFile'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
baseFile
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HandleSetBaseGfileMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsHandle a, Gio.File.IsFile b) => O.OverloadedMethod HandleSetBaseGfileMethodInfo a signature where
    overloadedMethod = handleSetBaseGfile

instance O.OverloadedMethodInfo HandleSetBaseGfileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleSetBaseGfile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleSetBaseGfile"
        })


#endif

-- method Handle::set_base_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "base_uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The base uri" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_set_base_uri" rsvg_handle_set_base_uri :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    CString ->                              -- base_uri : TBasicType TUTF8
    IO ()

-- | Set the base URI for this SVG.
-- 
-- Note: This function may only be called before 'GI.Rsvg.Objects.Handle.handleWrite' or
-- 'GI.Rsvg.Objects.Handle.handleReadStreamSync' have been called.
-- 
-- /Since: 2.9/
handleSetBaseUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: A t'GI.Rsvg.Objects.Handle.Handle'
    -> T.Text
    -- ^ /@baseUri@/: The base uri
    -> m ()
handleSetBaseUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Text -> m ()
handleSetBaseUri a
handle Text
baseUri = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    CString
baseUri' <- Text -> IO CString
textToCString Text
baseUri
    Ptr Handle -> CString -> IO ()
rsvg_handle_set_base_uri Ptr Handle
handle' CString
baseUri'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
baseUri'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HandleSetBaseUriMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleSetBaseUriMethodInfo a signature where
    overloadedMethod = handleSetBaseUri

instance O.OverloadedMethodInfo HandleSetBaseUriMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleSetBaseUri",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleSetBaseUri"
        })


#endif

-- method Handle::set_dpi
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dpi"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Dots Per Inch (i.e. as Pixels Per Inch)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_set_dpi" rsvg_handle_set_dpi :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    CDouble ->                              -- dpi : TBasicType TDouble
    IO ()

-- | Sets the DPI at which the /@handle@/ will be rendered. Common values are
-- 75, 90, and 300 DPI.
-- 
-- Passing a number \<= 0 to /@dpi@/ will reset the DPI to whatever the default
-- value happens to be, but since 'GI.Rsvg.Functions.setDefaultDpi' is deprecated, please
-- do not pass values \<= 0 to this function.
-- 
-- /Since: 2.8/
handleSetDpi ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> Double
    -- ^ /@dpi@/: Dots Per Inch (i.e. as Pixels Per Inch)
    -> m ()
handleSetDpi :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Double -> m ()
handleSetDpi a
handle Double
dpi = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    let dpi' :: CDouble
dpi' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dpi
    Ptr Handle -> CDouble -> IO ()
rsvg_handle_set_dpi Ptr Handle
handle' CDouble
dpi'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HandleSetDpiMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleSetDpiMethodInfo a signature where
    overloadedMethod = handleSetDpi

instance O.OverloadedMethodInfo HandleSetDpiMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleSetDpi",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleSetDpi"
        })


#endif

-- method Handle::set_dpi_x_y
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dpi_x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Dots Per Inch (i.e. Pixels Per Inch)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dpi_y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Dots Per Inch (i.e. Pixels Per Inch)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "rsvg_handle_set_dpi_x_y" rsvg_handle_set_dpi_x_y :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    CDouble ->                              -- dpi_x : TBasicType TDouble
    CDouble ->                              -- dpi_y : TBasicType TDouble
    IO ()

-- | Sets the DPI at which the /@handle@/ will be rendered. Common values are
-- 75, 90, and 300 DPI.
-- 
-- Passing a number \<= 0 to /@dpi@/ will reset the DPI to whatever the default
-- value happens to be, but since 'GI.Rsvg.Functions.setDefaultDpiXY' is deprecated,
-- please do not pass values \<= 0 to this function.
-- 
-- /Since: 2.8/
handleSetDpiXY ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: An t'GI.Rsvg.Objects.Handle.Handle'
    -> Double
    -- ^ /@dpiX@/: Dots Per Inch (i.e. Pixels Per Inch)
    -> Double
    -- ^ /@dpiY@/: Dots Per Inch (i.e. Pixels Per Inch)
    -> m ()
handleSetDpiXY :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> Double -> Double -> m ()
handleSetDpiXY a
handle Double
dpiX Double
dpiY = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    let dpiX' :: CDouble
dpiX' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dpiX
    let dpiY' :: CDouble
dpiY' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dpiY
    Ptr Handle -> CDouble -> CDouble -> IO ()
rsvg_handle_set_dpi_x_y Ptr Handle
handle' CDouble
dpiX' CDouble
dpiY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HandleSetDpiXYMethodInfo
instance (signature ~ (Double -> Double -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleSetDpiXYMethodInfo a signature where
    overloadedMethod = handleSetDpiXY

instance O.OverloadedMethodInfo HandleSetDpiXYMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleSetDpiXY",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleSetDpiXY"
        })


#endif

-- method Handle::set_stylesheet
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #RsvgHandle." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "css"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "String with CSS data; must be valid UTF-8."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "css_len"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Length of the @css data in bytes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "css_len"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "Length of the @css data in bytes."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_set_stylesheet" rsvg_handle_set_stylesheet :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Word8 ->                            -- css : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- css_len : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets a CSS stylesheet to use for an SVG document.
-- 
-- The /@cssLen@/ argument is mandatory; this function will not compute the length
-- of the /@css@/ string.  This is because a provided stylesheet, which the calling
-- program could read from a file, can have nul characters in it.
-- 
-- During the CSS cascade, the specified stylesheet will be used with a \"User\"
-- \<ulink
-- url=\"https:\/\/drafts.csswg.org\/css-cascade-3\/@/cascading/@-origins\">origin\<\/ulink>.
-- 
-- Note that @\@import@ rules will not be resolved, except for @data:@ URLs.
-- 
-- /Since: 2.48/
handleSetStylesheet ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: A t'GI.Rsvg.Objects.Handle.Handle'.
    -> ByteString
    -- ^ /@css@/: String with CSS data; must be valid UTF-8.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleSetStylesheet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> ByteString -> m ()
handleSetStylesheet a
handle ByteString
css = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let cssLen :: Word64
cssLen = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
css
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr Word8
css' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
css
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle -> Ptr Word8 -> Word64 -> Ptr (Ptr GError) -> IO CInt
rsvg_handle_set_stylesheet Ptr Handle
handle' Ptr Word8
css' Word64
cssLen
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
css'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
css'
     )

#if defined(ENABLE_OVERLOADING)
data HandleSetStylesheetMethodInfo
instance (signature ~ (ByteString -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleSetStylesheetMethodInfo a signature where
    overloadedMethod = handleSetStylesheet

instance O.OverloadedMethodInfo HandleSetStylesheetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleSetStylesheet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleSetStylesheet"
        })


#endif

-- method Handle::write
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Rsvg" , name = "Handle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #RsvgHandle" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buf"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to svg data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of the @buf buffer in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "count"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of the @buf buffer in bytes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "rsvg_handle_write" rsvg_handle_write :: 
    Ptr Handle ->                           -- handle : TInterface (Name {namespace = "Rsvg", name = "Handle"})
    Ptr Word8 ->                            -- buf : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- count : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED handleWrite ["(Since version 2.46.)","Use 'GI.Rsvg.Objects.Handle.handleReadStreamSync' or the constructor","functions 'GI.Rsvg.Objects.Handle.handleNewFromGfileSync' or","'GI.Rsvg.Objects.Handle.handleNewFromStreamSync'.  This function is deprecated because it","will accumulate data from the /@buf@/ in memory until 'GI.Rsvg.Objects.Handle.handleClose' gets","called.  To avoid a big temporary buffer, use the suggested functions, which","take a t'GI.Gio.Interfaces.File.File' or a t'GI.Gio.Objects.InputStream.InputStream' and do not require a temporary buffer."] #-}
-- | Loads the next /@count@/ bytes of the image.  You can call this function multiple
-- times until the whole document is consumed; then you must call 'GI.Rsvg.Objects.Handle.handleClose'
-- to actually parse the document.
-- 
-- Before calling this function for the first time, you may need to call
-- 'GI.Rsvg.Objects.Handle.handleSetBaseUri' or 'GI.Rsvg.Objects.Handle.handleSetBaseGfile' to set the \"base
-- file\" for resolving references to external resources.  SVG elements like
-- \<literal>&lt;image&gt;\<\/literal> which reference external resources will be
-- resolved relative to the location you specify with those functions.
handleWrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsHandle a) =>
    a
    -- ^ /@handle@/: an t'GI.Rsvg.Objects.Handle.Handle'
    -> ByteString
    -- ^ /@buf@/: pointer to svg data
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
handleWrite :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHandle a) =>
a -> ByteString -> m ()
handleWrite a
handle ByteString
buf = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let count :: Word64
count = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
buf
    Ptr Handle
handle' <- a -> IO (Ptr Handle)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
handle
    Ptr Word8
buf' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
buf
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Handle -> Ptr Word8 -> Word64 -> Ptr (Ptr GError) -> IO CInt
rsvg_handle_write Ptr Handle
handle' Ptr Word8
buf' Word64
count
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
handle
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buf'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buf'
     )

#if defined(ENABLE_OVERLOADING)
data HandleWriteMethodInfo
instance (signature ~ (ByteString -> m ()), MonadIO m, IsHandle a) => O.OverloadedMethod HandleWriteMethodInfo a signature where
    overloadedMethod = handleWrite

instance O.OverloadedMethodInfo HandleWriteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Rsvg.Objects.Handle.handleWrite",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-rsvg-2.0.2/docs/GI-Rsvg-Objects-Handle.html#v:handleWrite"
        })


#endif