{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

Data structure for holding a destination
-}

module GI.Poppler.Structs.Dest
    ( 

-- * Exported types
    Dest(..)                                ,
    newZeroDest                             ,
    noDest                                  ,


 -- * Methods
-- ** copy #method:copy#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    DestCopyMethodInfo                      ,
#endif
    destCopy                                ,


-- ** free #method:free#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    DestFreeMethodInfo                      ,
#endif
    destFree                                ,




 -- * Properties
-- ** bottom #attr:bottom#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_bottom                             ,
#endif
    getDestBottom                           ,
    setDestBottom                           ,


-- ** changeLeft #attr:changeLeft#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_changeLeft                         ,
#endif
    getDestChangeLeft                       ,
    setDestChangeLeft                       ,


-- ** changeTop #attr:changeTop#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_changeTop                          ,
#endif
    getDestChangeTop                        ,
    setDestChangeTop                        ,


-- ** changeZoom #attr:changeZoom#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_changeZoom                         ,
#endif
    getDestChangeZoom                       ,
    setDestChangeZoom                       ,


-- ** left #attr:left#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_left                               ,
#endif
    getDestLeft                             ,
    setDestLeft                             ,


-- ** namedDest #attr:namedDest#
    clearDestNamedDest                      ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_namedDest                          ,
#endif
    getDestNamedDest                        ,
    setDestNamedDest                        ,


-- ** pageNum #attr:pageNum#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_pageNum                            ,
#endif
    getDestPageNum                          ,
    setDestPageNum                          ,


-- ** right #attr:right#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_right                              ,
#endif
    getDestRight                            ,
    setDestRight                            ,


-- ** top #attr:top#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_top                                ,
#endif
    getDestTop                              ,
    setDestTop                              ,


-- ** type #attr:type#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_type                               ,
#endif
    getDestType                             ,
    setDestType                             ,


-- ** zoom #attr:zoom#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    dest_zoom                               ,
#endif
    getDestZoom                             ,
    setDestZoom                             ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums

newtype Dest = Dest (ManagedPtr Dest)
foreign import ccall "poppler_dest_get_type" c_poppler_dest_get_type :: 
    IO GType

instance BoxedObject Dest where
    boxedType _ = c_poppler_dest_get_type

-- | Construct a `Dest` struct initialized to zero.
newZeroDest :: MonadIO m => m Dest
newZeroDest = liftIO $ callocBoxedBytes 72 >>= wrapBoxed Dest

instance tag ~ 'AttrSet => Constructible Dest tag where
    new _ attrs = do
        o <- newZeroDest
        GI.Attributes.set o attrs
        return o


noDest :: Maybe Dest
noDest = Nothing

getDestType :: MonadIO m => Dest -> m Poppler.Enums.DestType
getDestType s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setDestType :: MonadIO m => Dest -> Poppler.Enums.DestType -> m ()
setDestType s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestTypeFieldInfo
instance AttrInfo DestTypeFieldInfo where
    type AttrAllowedOps DestTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestTypeFieldInfo = (~) Poppler.Enums.DestType
    type AttrBaseTypeConstraint DestTypeFieldInfo = (~) Dest
    type AttrGetType DestTypeFieldInfo = Poppler.Enums.DestType
    type AttrLabel DestTypeFieldInfo = "type"
    type AttrOrigin DestTypeFieldInfo = Dest
    attrGet _ = getDestType
    attrSet _ = setDestType
    attrConstruct = undefined
    attrClear _ = undefined

dest_type :: AttrLabelProxy "type"
dest_type = AttrLabelProxy

#endif


getDestPageNum :: MonadIO m => Dest -> m Int32
getDestPageNum s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 4) :: IO Int32
    return val

setDestPageNum :: MonadIO m => Dest -> Int32 -> m ()
setDestPageNum s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 4) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestPageNumFieldInfo
instance AttrInfo DestPageNumFieldInfo where
    type AttrAllowedOps DestPageNumFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestPageNumFieldInfo = (~) Int32
    type AttrBaseTypeConstraint DestPageNumFieldInfo = (~) Dest
    type AttrGetType DestPageNumFieldInfo = Int32
    type AttrLabel DestPageNumFieldInfo = "page_num"
    type AttrOrigin DestPageNumFieldInfo = Dest
    attrGet _ = getDestPageNum
    attrSet _ = setDestPageNum
    attrConstruct = undefined
    attrClear _ = undefined

dest_pageNum :: AttrLabelProxy "pageNum"
dest_pageNum = AttrLabelProxy

#endif


getDestLeft :: MonadIO m => Dest -> m Double
getDestLeft s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CDouble
    let val' = realToFrac val
    return val'

setDestLeft :: MonadIO m => Dest -> Double -> m ()
setDestLeft s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 8) (val' :: CDouble)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestLeftFieldInfo
instance AttrInfo DestLeftFieldInfo where
    type AttrAllowedOps DestLeftFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestLeftFieldInfo = (~) Double
    type AttrBaseTypeConstraint DestLeftFieldInfo = (~) Dest
    type AttrGetType DestLeftFieldInfo = Double
    type AttrLabel DestLeftFieldInfo = "left"
    type AttrOrigin DestLeftFieldInfo = Dest
    attrGet _ = getDestLeft
    attrSet _ = setDestLeft
    attrConstruct = undefined
    attrClear _ = undefined

dest_left :: AttrLabelProxy "left"
dest_left = AttrLabelProxy

#endif


getDestBottom :: MonadIO m => Dest -> m Double
getDestBottom s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CDouble
    let val' = realToFrac val
    return val'

setDestBottom :: MonadIO m => Dest -> Double -> m ()
setDestBottom s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 16) (val' :: CDouble)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestBottomFieldInfo
instance AttrInfo DestBottomFieldInfo where
    type AttrAllowedOps DestBottomFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestBottomFieldInfo = (~) Double
    type AttrBaseTypeConstraint DestBottomFieldInfo = (~) Dest
    type AttrGetType DestBottomFieldInfo = Double
    type AttrLabel DestBottomFieldInfo = "bottom"
    type AttrOrigin DestBottomFieldInfo = Dest
    attrGet _ = getDestBottom
    attrSet _ = setDestBottom
    attrConstruct = undefined
    attrClear _ = undefined

dest_bottom :: AttrLabelProxy "bottom"
dest_bottom = AttrLabelProxy

#endif


getDestRight :: MonadIO m => Dest -> m Double
getDestRight s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO CDouble
    let val' = realToFrac val
    return val'

setDestRight :: MonadIO m => Dest -> Double -> m ()
setDestRight s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 24) (val' :: CDouble)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestRightFieldInfo
instance AttrInfo DestRightFieldInfo where
    type AttrAllowedOps DestRightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestRightFieldInfo = (~) Double
    type AttrBaseTypeConstraint DestRightFieldInfo = (~) Dest
    type AttrGetType DestRightFieldInfo = Double
    type AttrLabel DestRightFieldInfo = "right"
    type AttrOrigin DestRightFieldInfo = Dest
    attrGet _ = getDestRight
    attrSet _ = setDestRight
    attrConstruct = undefined
    attrClear _ = undefined

dest_right :: AttrLabelProxy "right"
dest_right = AttrLabelProxy

#endif


getDestTop :: MonadIO m => Dest -> m Double
getDestTop s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO CDouble
    let val' = realToFrac val
    return val'

setDestTop :: MonadIO m => Dest -> Double -> m ()
setDestTop s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 32) (val' :: CDouble)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestTopFieldInfo
instance AttrInfo DestTopFieldInfo where
    type AttrAllowedOps DestTopFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestTopFieldInfo = (~) Double
    type AttrBaseTypeConstraint DestTopFieldInfo = (~) Dest
    type AttrGetType DestTopFieldInfo = Double
    type AttrLabel DestTopFieldInfo = "top"
    type AttrOrigin DestTopFieldInfo = Dest
    attrGet _ = getDestTop
    attrSet _ = setDestTop
    attrConstruct = undefined
    attrClear _ = undefined

dest_top :: AttrLabelProxy "top"
dest_top = AttrLabelProxy

#endif


getDestZoom :: MonadIO m => Dest -> m Double
getDestZoom s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 40) :: IO CDouble
    let val' = realToFrac val
    return val'

setDestZoom :: MonadIO m => Dest -> Double -> m ()
setDestZoom s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 40) (val' :: CDouble)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestZoomFieldInfo
instance AttrInfo DestZoomFieldInfo where
    type AttrAllowedOps DestZoomFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestZoomFieldInfo = (~) Double
    type AttrBaseTypeConstraint DestZoomFieldInfo = (~) Dest
    type AttrGetType DestZoomFieldInfo = Double
    type AttrLabel DestZoomFieldInfo = "zoom"
    type AttrOrigin DestZoomFieldInfo = Dest
    attrGet _ = getDestZoom
    attrSet _ = setDestZoom
    attrConstruct = undefined
    attrClear _ = undefined

dest_zoom :: AttrLabelProxy "zoom"
dest_zoom = AttrLabelProxy

#endif


getDestNamedDest :: MonadIO m => Dest -> m (Maybe T.Text)
getDestNamedDest s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 48) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setDestNamedDest :: MonadIO m => Dest -> CString -> m ()
setDestNamedDest s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (val :: CString)

clearDestNamedDest :: MonadIO m => Dest -> m ()
clearDestNamedDest s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestNamedDestFieldInfo
instance AttrInfo DestNamedDestFieldInfo where
    type AttrAllowedOps DestNamedDestFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DestNamedDestFieldInfo = (~) CString
    type AttrBaseTypeConstraint DestNamedDestFieldInfo = (~) Dest
    type AttrGetType DestNamedDestFieldInfo = Maybe T.Text
    type AttrLabel DestNamedDestFieldInfo = "named_dest"
    type AttrOrigin DestNamedDestFieldInfo = Dest
    attrGet _ = getDestNamedDest
    attrSet _ = setDestNamedDest
    attrConstruct = undefined
    attrClear _ = clearDestNamedDest

dest_namedDest :: AttrLabelProxy "namedDest"
dest_namedDest = AttrLabelProxy

#endif


getDestChangeLeft :: MonadIO m => Dest -> m Word32
getDestChangeLeft s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO Word32
    return val

setDestChangeLeft :: MonadIO m => Dest -> Word32 -> m ()
setDestChangeLeft s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestChangeLeftFieldInfo
instance AttrInfo DestChangeLeftFieldInfo where
    type AttrAllowedOps DestChangeLeftFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestChangeLeftFieldInfo = (~) Word32
    type AttrBaseTypeConstraint DestChangeLeftFieldInfo = (~) Dest
    type AttrGetType DestChangeLeftFieldInfo = Word32
    type AttrLabel DestChangeLeftFieldInfo = "change_left"
    type AttrOrigin DestChangeLeftFieldInfo = Dest
    attrGet _ = getDestChangeLeft
    attrSet _ = setDestChangeLeft
    attrConstruct = undefined
    attrClear _ = undefined

dest_changeLeft :: AttrLabelProxy "changeLeft"
dest_changeLeft = AttrLabelProxy

#endif


getDestChangeTop :: MonadIO m => Dest -> m Word32
getDestChangeTop s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 60) :: IO Word32
    return val

setDestChangeTop :: MonadIO m => Dest -> Word32 -> m ()
setDestChangeTop s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 60) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestChangeTopFieldInfo
instance AttrInfo DestChangeTopFieldInfo where
    type AttrAllowedOps DestChangeTopFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestChangeTopFieldInfo = (~) Word32
    type AttrBaseTypeConstraint DestChangeTopFieldInfo = (~) Dest
    type AttrGetType DestChangeTopFieldInfo = Word32
    type AttrLabel DestChangeTopFieldInfo = "change_top"
    type AttrOrigin DestChangeTopFieldInfo = Dest
    attrGet _ = getDestChangeTop
    attrSet _ = setDestChangeTop
    attrConstruct = undefined
    attrClear _ = undefined

dest_changeTop :: AttrLabelProxy "changeTop"
dest_changeTop = AttrLabelProxy

#endif


getDestChangeZoom :: MonadIO m => Dest -> m Word32
getDestChangeZoom s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 64) :: IO Word32
    return val

setDestChangeZoom :: MonadIO m => Dest -> Word32 -> m ()
setDestChangeZoom s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 64) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestChangeZoomFieldInfo
instance AttrInfo DestChangeZoomFieldInfo where
    type AttrAllowedOps DestChangeZoomFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestChangeZoomFieldInfo = (~) Word32
    type AttrBaseTypeConstraint DestChangeZoomFieldInfo = (~) Dest
    type AttrGetType DestChangeZoomFieldInfo = Word32
    type AttrLabel DestChangeZoomFieldInfo = "change_zoom"
    type AttrOrigin DestChangeZoomFieldInfo = Dest
    attrGet _ = getDestChangeZoom
    attrSet _ = setDestChangeZoom
    attrConstruct = undefined
    attrClear _ = undefined

dest_changeZoom :: AttrLabelProxy "changeZoom"
dest_changeZoom = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList Dest
type instance O.AttributeList Dest = DestAttributeList
type DestAttributeList = ('[ '("type", DestTypeFieldInfo), '("pageNum", DestPageNumFieldInfo), '("left", DestLeftFieldInfo), '("bottom", DestBottomFieldInfo), '("right", DestRightFieldInfo), '("top", DestTopFieldInfo), '("zoom", DestZoomFieldInfo), '("namedDest", DestNamedDestFieldInfo), '("changeLeft", DestChangeLeftFieldInfo), '("changeTop", DestChangeTopFieldInfo), '("changeZoom", DestChangeZoomFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "poppler_dest_copy" poppler_dest_copy :: 
    Ptr Dest ->                             -- dest : TInterface (Name {namespace = "Poppler", name = "Dest"})
    IO (Ptr Dest)

{- |
Copies /@dest@/, creating an identical 'GI.Poppler.Structs.Dest.Dest'.
-}
destCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dest
    {- ^ /@dest@/: a 'GI.Poppler.Structs.Dest.Dest' -}
    -> m Dest
    {- ^ __Returns:__ a new destination identical to /@dest@/ -}
destCopy dest = liftIO $ do
    dest' <- unsafeManagedPtrGetPtr dest
    result <- poppler_dest_copy dest'
    checkUnexpectedReturnNULL "destCopy" result
    result' <- (wrapBoxed Dest) result
    touchManagedPtr dest
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestCopyMethodInfo
instance (signature ~ (m Dest), MonadIO m) => O.MethodInfo DestCopyMethodInfo Dest signature where
    overloadedMethod _ = destCopy

#endif

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

foreign import ccall "poppler_dest_free" poppler_dest_free :: 
    Ptr Dest ->                             -- dest : TInterface (Name {namespace = "Poppler", name = "Dest"})
    IO ()

{- |
Frees /@dest@/
-}
destFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dest
    {- ^ /@dest@/: a 'GI.Poppler.Structs.Dest.Dest' -}
    -> m ()
destFree dest = liftIO $ do
    dest' <- unsafeManagedPtrGetPtr dest
    poppler_dest_free dest'
    touchManagedPtr dest
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data DestFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DestFreeMethodInfo Dest signature where
    overloadedMethod _ = destFree

#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveDestMethod (t :: Symbol) (o :: *) :: * where
    ResolveDestMethod "copy" o = DestCopyMethodInfo
    ResolveDestMethod "free" o = DestFreeMethodInfo
    ResolveDestMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDestMethod t Dest, O.MethodInfo info Dest p) => O.IsLabelProxy t (Dest -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveDestMethod t Dest, O.MethodInfo info Dest p) => O.IsLabel t (Dest -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif

#endif