{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Poppler.Structs.Rectangle.Rectangle' is used to describe
-- locations on a page and bounding boxes

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

module GI.Poppler.Structs.Rectangle
    ( 

-- * Exported types
    Rectangle(..)                           ,
    newZeroRectangle                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRectangleMethod                  ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    RectangleCopyMethodInfo                 ,
#endif
    rectangleCopy                           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    RectangleFreeMethodInfo                 ,
#endif
    rectangleFree                           ,


-- ** new #method:new#

    rectangleNew                            ,




 -- * Properties
-- ** x1 #attr:x1#
-- | x coordinate of lower left corner

    getRectangleX1                          ,
#if defined(ENABLE_OVERLOADING)
    rectangle_x1                            ,
#endif
    setRectangleX1                          ,


-- ** x2 #attr:x2#
-- | x coordinate of upper right corner

    getRectangleX2                          ,
#if defined(ENABLE_OVERLOADING)
    rectangle_x2                            ,
#endif
    setRectangleX2                          ,


-- ** y1 #attr:y1#
-- | y coordinate of lower left corner

    getRectangleY1                          ,
#if defined(ENABLE_OVERLOADING)
    rectangle_y1                            ,
#endif
    setRectangleY1                          ,


-- ** y2 #attr:y2#
-- | y coordinate of upper right corner

    getRectangleY2                          ,
#if defined(ENABLE_OVERLOADING)
    rectangle_y2                            ,
#endif
    setRectangleY2                          ,




    ) 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.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.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


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

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

foreign import ccall "poppler_rectangle_get_type" c_poppler_rectangle_get_type :: 
    IO GType

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

instance B.Types.TypedObject Rectangle where
    glibType :: IO GType
glibType = IO GType
c_poppler_rectangle_get_type

instance B.Types.GBoxed Rectangle

-- | Convert 'Rectangle' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Rectangle where
    toGValue :: Rectangle -> IO GValue
toGValue Rectangle
o = do
        GType
gtype <- IO GType
c_poppler_rectangle_get_type
        Rectangle -> (Ptr Rectangle -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Rectangle
o (GType
-> (GValue -> Ptr Rectangle -> IO ()) -> Ptr Rectangle -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Rectangle -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Rectangle
fromGValue GValue
gv = do
        Ptr Rectangle
ptr <- GValue -> IO (Ptr Rectangle)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Rectangle)
        (ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Rectangle -> Rectangle
Rectangle Ptr Rectangle
ptr
        
    

-- | Construct a `Rectangle` struct initialized to zero.
newZeroRectangle :: MonadIO m => m Rectangle
newZeroRectangle :: m Rectangle
newZeroRectangle = IO Rectangle -> m Rectangle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
32 IO (Ptr Rectangle)
-> (Ptr Rectangle -> IO Rectangle) -> IO Rectangle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Rectangle

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


-- | Get the value of the “@x1@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rectangle #x1
-- @
getRectangleX1 :: MonadIO m => Rectangle -> m Double
getRectangleX1 :: Rectangle -> m Double
getRectangleX1 Rectangle
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Rectangle -> (Ptr Rectangle -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rectangle
s ((Ptr Rectangle -> IO Double) -> IO Double)
-> (Ptr Rectangle -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Rectangle
ptr Ptr Rectangle -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

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

#if defined(ENABLE_OVERLOADING)
data RectangleX1FieldInfo
instance AttrInfo RectangleX1FieldInfo where
    type AttrBaseTypeConstraint RectangleX1FieldInfo = (~) Rectangle
    type AttrAllowedOps RectangleX1FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RectangleX1FieldInfo = (~) Double
    type AttrTransferTypeConstraint RectangleX1FieldInfo = (~)Double
    type AttrTransferType RectangleX1FieldInfo = Double
    type AttrGetType RectangleX1FieldInfo = Double
    type AttrLabel RectangleX1FieldInfo = "x1"
    type AttrOrigin RectangleX1FieldInfo = Rectangle
    attrGet = getRectangleX1
    attrSet = setRectangleX1
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

rectangle_x1 :: AttrLabelProxy "x1"
rectangle_x1 = AttrLabelProxy

#endif


-- | Get the value of the “@y1@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rectangle #y1
-- @
getRectangleY1 :: MonadIO m => Rectangle -> m Double
getRectangleY1 :: Rectangle -> m Double
getRectangleY1 Rectangle
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Rectangle -> (Ptr Rectangle -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rectangle
s ((Ptr Rectangle -> IO Double) -> IO Double)
-> (Ptr Rectangle -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Rectangle
ptr Ptr Rectangle -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

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

#if defined(ENABLE_OVERLOADING)
data RectangleY1FieldInfo
instance AttrInfo RectangleY1FieldInfo where
    type AttrBaseTypeConstraint RectangleY1FieldInfo = (~) Rectangle
    type AttrAllowedOps RectangleY1FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RectangleY1FieldInfo = (~) Double
    type AttrTransferTypeConstraint RectangleY1FieldInfo = (~)Double
    type AttrTransferType RectangleY1FieldInfo = Double
    type AttrGetType RectangleY1FieldInfo = Double
    type AttrLabel RectangleY1FieldInfo = "y1"
    type AttrOrigin RectangleY1FieldInfo = Rectangle
    attrGet = getRectangleY1
    attrSet = setRectangleY1
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

rectangle_y1 :: AttrLabelProxy "y1"
rectangle_y1 = AttrLabelProxy

#endif


-- | Get the value of the “@x2@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rectangle #x2
-- @
getRectangleX2 :: MonadIO m => Rectangle -> m Double
getRectangleX2 :: Rectangle -> m Double
getRectangleX2 Rectangle
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Rectangle -> (Ptr Rectangle -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rectangle
s ((Ptr Rectangle -> IO Double) -> IO Double)
-> (Ptr Rectangle -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Rectangle
ptr Ptr Rectangle -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

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

#if defined(ENABLE_OVERLOADING)
data RectangleX2FieldInfo
instance AttrInfo RectangleX2FieldInfo where
    type AttrBaseTypeConstraint RectangleX2FieldInfo = (~) Rectangle
    type AttrAllowedOps RectangleX2FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RectangleX2FieldInfo = (~) Double
    type AttrTransferTypeConstraint RectangleX2FieldInfo = (~)Double
    type AttrTransferType RectangleX2FieldInfo = Double
    type AttrGetType RectangleX2FieldInfo = Double
    type AttrLabel RectangleX2FieldInfo = "x2"
    type AttrOrigin RectangleX2FieldInfo = Rectangle
    attrGet = getRectangleX2
    attrSet = setRectangleX2
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

rectangle_x2 :: AttrLabelProxy "x2"
rectangle_x2 = AttrLabelProxy

#endif


-- | Get the value of the “@y2@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rectangle #y2
-- @
getRectangleY2 :: MonadIO m => Rectangle -> m Double
getRectangleY2 :: Rectangle -> m Double
getRectangleY2 Rectangle
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Rectangle -> (Ptr Rectangle -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Rectangle
s ((Ptr Rectangle -> IO Double) -> IO Double)
-> (Ptr Rectangle -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Rectangle
ptr Ptr Rectangle -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

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

#if defined(ENABLE_OVERLOADING)
data RectangleY2FieldInfo
instance AttrInfo RectangleY2FieldInfo where
    type AttrBaseTypeConstraint RectangleY2FieldInfo = (~) Rectangle
    type AttrAllowedOps RectangleY2FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RectangleY2FieldInfo = (~) Double
    type AttrTransferTypeConstraint RectangleY2FieldInfo = (~)Double
    type AttrTransferType RectangleY2FieldInfo = Double
    type AttrGetType RectangleY2FieldInfo = Double
    type AttrLabel RectangleY2FieldInfo = "y2"
    type AttrOrigin RectangleY2FieldInfo = Rectangle
    attrGet = getRectangleY2
    attrSet = setRectangleY2
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

rectangle_y2 :: AttrLabelProxy "y2"
rectangle_y2 = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Rectangle
type instance O.AttributeList Rectangle = RectangleAttributeList
type RectangleAttributeList = ('[ '("x1", RectangleX1FieldInfo), '("y1", RectangleY1FieldInfo), '("x2", RectangleX2FieldInfo), '("y2", RectangleY2FieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "poppler_rectangle_new" poppler_rectangle_new :: 
    IO (Ptr Rectangle)

-- | Creates a new t'GI.Poppler.Structs.Rectangle.Rectangle'
rectangleNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Rectangle
    -- ^ __Returns:__ a new t'GI.Poppler.Structs.Rectangle.Rectangle', use 'GI.Poppler.Structs.Rectangle.rectangleFree' to free it
rectangleNew :: m Rectangle
rectangleNew  = IO Rectangle -> m Rectangle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rectangle
result <- IO (Ptr Rectangle)
poppler_rectangle_new
    Text -> Ptr Rectangle -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rectangleNew" Ptr Rectangle
result
    Rectangle
result' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Rectangle) Ptr Rectangle
result
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Rectangle::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rectangle"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerRectangle to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "Rectangle" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_rectangle_copy" poppler_rectangle_copy :: 
    Ptr Rectangle ->                        -- rectangle : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO (Ptr Rectangle)

-- | Creates a copy of /@rectangle@/
rectangleCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rectangle
    -- ^ /@rectangle@/: a t'GI.Poppler.Structs.Rectangle.Rectangle' to copy
    -> m Rectangle
    -- ^ __Returns:__ a new allocated copy of /@rectangle@/
rectangleCopy :: Rectangle -> m Rectangle
rectangleCopy Rectangle
rectangle = IO Rectangle -> m Rectangle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rectangle
rectangle' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
rectangle
    Ptr Rectangle
result <- Ptr Rectangle -> IO (Ptr Rectangle)
poppler_rectangle_copy Ptr Rectangle
rectangle'
    Text -> Ptr Rectangle -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rectangleCopy" Ptr Rectangle
result
    Rectangle
result' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Rectangle) Ptr Rectangle
result
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
rectangle
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
result'

#if defined(ENABLE_OVERLOADING)
data RectangleCopyMethodInfo
instance (signature ~ (m Rectangle), MonadIO m) => O.MethodInfo RectangleCopyMethodInfo Rectangle signature where
    overloadedMethod = rectangleCopy

#endif

-- method Rectangle::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rectangle"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerRectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_rectangle_free" poppler_rectangle_free :: 
    Ptr Rectangle ->                        -- rectangle : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO ()

-- | Frees the given t'GI.Poppler.Structs.Rectangle.Rectangle'
rectangleFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Rectangle
    -- ^ /@rectangle@/: a t'GI.Poppler.Structs.Rectangle.Rectangle'
    -> m ()
rectangleFree :: Rectangle -> m ()
rectangleFree Rectangle
rectangle = 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 Rectangle
rectangle' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
rectangle
    Ptr Rectangle -> IO ()
poppler_rectangle_free Ptr Rectangle
rectangle'
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
rectangle
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RectangleFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo RectangleFreeMethodInfo Rectangle signature where
    overloadedMethod = rectangleFree

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRectangleMethod (t :: Symbol) (o :: *) :: * where
    ResolveRectangleMethod "copy" o = RectangleCopyMethodInfo
    ResolveRectangleMethod "free" o = RectangleFreeMethodInfo
    ResolveRectangleMethod l o = O.MethodResolutionFailed l o

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

#endif