{-# 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.Point.Point' is used to describe a location point on a page

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

module GI.Poppler.Structs.Point
    ( 

-- * Exported types
    Point(..)                               ,
    newZeroPoint                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Poppler.Structs.Point#g:method:copy"), [free]("GI.Poppler.Structs.Point#g:method:free").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolvePointMethod                      ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    PointCopyMethodInfo                     ,
#endif
    pointCopy                               ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    PointFreeMethodInfo                     ,
#endif
    pointFree                               ,


-- ** new #method:new#

    pointNew                                ,




 -- * Properties


-- ** x #attr:x#
-- | x coordinate

    getPointX                               ,
#if defined(ENABLE_OVERLOADING)
    point_x                                 ,
#endif
    setPointX                               ,


-- ** y #attr:y#
-- | y coordinate

    getPointY                               ,
#if defined(ENABLE_OVERLOADING)
    point_y                                 ,
#endif
    setPointY                               ,




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


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

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

foreign import ccall "poppler_point_get_type" c_poppler_point_get_type :: 
    IO GType

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

instance B.Types.TypedObject Point where
    glibType :: IO GType
glibType = IO GType
c_poppler_point_get_type

instance B.Types.GBoxed Point

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

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

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


-- | Get the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' point #x
-- @
getPointX :: MonadIO m => Point -> m Double
getPointX :: forall (m :: * -> *). MonadIO m => Point -> m Double
getPointX Point
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
$ Point -> (Ptr Point -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point
s ((Ptr Point -> IO Double) -> IO Double)
-> (Ptr Point -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Point
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Point
ptr Ptr Point -> 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 “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' point [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setPointX :: MonadIO m => Point -> Double -> m ()
setPointX :: forall (m :: * -> *). MonadIO m => Point -> Double -> m ()
setPointX Point
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
$ Point -> (Ptr Point -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point
s ((Ptr Point -> IO ()) -> IO ()) -> (Ptr Point -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Point
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 Point
ptr Ptr Point -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data PointXFieldInfo
instance AttrInfo PointXFieldInfo where
    type AttrBaseTypeConstraint PointXFieldInfo = (~) Point
    type AttrAllowedOps PointXFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PointXFieldInfo = (~) Double
    type AttrTransferTypeConstraint PointXFieldInfo = (~)Double
    type AttrTransferType PointXFieldInfo = Double
    type AttrGetType PointXFieldInfo = Double
    type AttrLabel PointXFieldInfo = "x"
    type AttrOrigin PointXFieldInfo = Point
    attrGet = getPointX
    attrSet = setPointX
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

point_x :: AttrLabelProxy "x"
point_x = AttrLabelProxy

#endif


-- | Get the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' point #y
-- @
getPointY :: MonadIO m => Point -> m Double
getPointY :: forall (m :: * -> *). MonadIO m => Point -> m Double
getPointY Point
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
$ Point -> (Ptr Point -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point
s ((Ptr Point -> IO Double) -> IO Double)
-> (Ptr Point -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Point
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Point
ptr Ptr Point -> 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 “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' point [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setPointY :: MonadIO m => Point -> Double -> m ()
setPointY :: forall (m :: * -> *). MonadIO m => Point -> Double -> m ()
setPointY Point
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
$ Point -> (Ptr Point -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point
s ((Ptr Point -> IO ()) -> IO ()) -> (Ptr Point -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Point
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 Point
ptr Ptr Point -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data PointYFieldInfo
instance AttrInfo PointYFieldInfo where
    type AttrBaseTypeConstraint PointYFieldInfo = (~) Point
    type AttrAllowedOps PointYFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PointYFieldInfo = (~) Double
    type AttrTransferTypeConstraint PointYFieldInfo = (~)Double
    type AttrTransferType PointYFieldInfo = Double
    type AttrGetType PointYFieldInfo = Double
    type AttrLabel PointYFieldInfo = "y"
    type AttrOrigin PointYFieldInfo = Point
    attrGet = getPointY
    attrSet = setPointY
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

point_y :: AttrLabelProxy "y"
point_y = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Point
type instance O.AttributeList Point = PointAttributeList
type PointAttributeList = ('[ '("x", PointXFieldInfo), '("y", PointYFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "poppler_point_new" poppler_point_new :: 
    IO (Ptr Point)

-- | Creates a new t'GI.Poppler.Structs.Point.Point'. It must be freed with 'GI.Poppler.Structs.Point.pointFree' after use.
-- 
-- /Since: 0.26/
pointNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Point
    -- ^ __Returns:__ a new t'GI.Poppler.Structs.Point.Point'
pointNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Point
pointNew  = IO Point -> m Point
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point
result <- IO (Ptr Point)
poppler_point_new
    Text -> Ptr Point -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pointNew" Ptr Point
result
    Point
result' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Point) Ptr Point
result
    Point -> IO Point
forall (m :: * -> *) a. Monad m => a -> m a
return Point
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "poppler_point_copy" poppler_point_copy :: 
    Ptr Point ->                            -- point : TInterface (Name {namespace = "Poppler", name = "Point"})
    IO (Ptr Point)

-- | Creates a copy of /@point@/. The copy must be freed with 'GI.Poppler.Structs.Point.pointFree'
-- after use.
-- 
-- /Since: 0.26/
pointCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point
    -- ^ /@point@/: a t'GI.Poppler.Structs.Point.Point' to copy
    -> m Point
    -- ^ __Returns:__ a new allocated copy of /@point@/
pointCopy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Point -> m Point
pointCopy Point
point = IO Point -> m Point
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    Ptr Point
result <- Ptr Point -> IO (Ptr Point)
poppler_point_copy Ptr Point
point'
    Text -> Ptr Point -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pointCopy" Ptr Point
result
    Point
result' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Point) Ptr Point
result
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    Point -> IO Point
forall (m :: * -> *) a. Monad m => a -> m a
return Point
result'

#if defined(ENABLE_OVERLOADING)
data PointCopyMethodInfo
instance (signature ~ (m Point), MonadIO m) => O.OverloadedMethod PointCopyMethodInfo Point signature where
    overloadedMethod = pointCopy

instance O.OverloadedMethodInfo PointCopyMethodInfo Point where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Structs.Point.pointCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Structs-Point.html#v:pointCopy"
        }


#endif

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

foreign import ccall "poppler_point_free" poppler_point_free :: 
    Ptr Point ->                            -- point : TInterface (Name {namespace = "Poppler", name = "Point"})
    IO ()

-- | Frees the memory used by /@point@/
-- 
-- /Since: 0.26/
pointFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point
    -- ^ /@point@/: a t'GI.Poppler.Structs.Point.Point'
    -> m ()
pointFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Point -> m ()
pointFree Point
point = 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 Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    Ptr Point -> IO ()
poppler_point_free Ptr Point
point'
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PointFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PointFreeMethodInfo Point signature where
    overloadedMethod = pointFree

instance O.OverloadedMethodInfo PointFreeMethodInfo Point where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Structs.Point.pointFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Structs-Point.html#v:pointFree"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePointMethod (t :: Symbol) (o :: *) :: * where
    ResolvePointMethod "copy" o = PointCopyMethodInfo
    ResolvePointMethod "free" o = PointFreeMethodInfo
    ResolvePointMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif