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

A data structure for holding actions
-}

module GI.Poppler.Unions.Action
    ( 

-- * Exported types
    Action(..)                              ,
    newZeroAction                           ,
    noAction                                ,


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


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




 -- * Properties
-- ** any #attr:any#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_any                              ,
#endif
    getActionAny                            ,


-- ** gotoDest #attr:gotoDest#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_gotoDest                         ,
#endif
    getActionGotoDest                       ,


-- ** gotoRemote #attr:gotoRemote#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_gotoRemote                       ,
#endif
    getActionGotoRemote                     ,


-- ** javascript #attr:javascript#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_javascript                       ,
#endif
    getActionJavascript                     ,


-- ** launch #attr:launch#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_launch                           ,
#endif
    getActionLaunch                         ,


-- ** movie #attr:movie#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_movie                            ,
#endif
    getActionMovie                          ,


-- ** named #attr:named#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_named                            ,
#endif
    getActionNamed                          ,


-- ** ocgState #attr:ocgState#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_ocgState                         ,
#endif
    getActionOcgState                       ,


-- ** rendition #attr:rendition#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_rendition                        ,
#endif
    getActionRendition                      ,


-- ** type #attr:type#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_type                             ,
#endif
    getActionType                           ,
    setActionType                           ,


-- ** uri #attr:uri#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    action_uri                              ,
#endif
    getActionUri                            ,




    ) 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
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionAny as Poppler.ActionAny
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionGotoDest as Poppler.ActionGotoDest
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionGotoRemote as Poppler.ActionGotoRemote
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionJavascript as Poppler.ActionJavascript
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionLaunch as Poppler.ActionLaunch
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionMovie as Poppler.ActionMovie
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionNamed as Poppler.ActionNamed
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionOCGState as Poppler.ActionOCGState
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionRendition as Poppler.ActionRendition
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionUri as Poppler.ActionUri

newtype Action = Action (ManagedPtr Action)
foreign import ccall "poppler_action_get_type" c_poppler_action_get_type :: 
    IO GType

instance BoxedObject Action where
    boxedType _ = c_poppler_action_get_type

-- | Construct a `Action` struct initialized to zero.
newZeroAction :: MonadIO m => m Action
newZeroAction = liftIO $ callocBoxedBytes 32 >>= wrapBoxed Action

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


noAction :: Maybe Action
noAction = Nothing

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

setActionType :: MonadIO m => Action -> Poppler.Enums.ActionType -> m ()
setActionType 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 ActionTypeFieldInfo
instance AttrInfo ActionTypeFieldInfo where
    type AttrAllowedOps ActionTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionTypeFieldInfo = (~) Poppler.Enums.ActionType
    type AttrBaseTypeConstraint ActionTypeFieldInfo = (~) Action
    type AttrGetType ActionTypeFieldInfo = Poppler.Enums.ActionType
    type AttrLabel ActionTypeFieldInfo = "type"
    type AttrOrigin ActionTypeFieldInfo = Action
    attrGet _ = getActionType
    attrSet _ = setActionType
    attrConstruct = undefined
    attrClear _ = undefined

action_type :: AttrLabelProxy "type"
action_type = AttrLabelProxy

#endif


getActionAny :: MonadIO m => Action -> m Poppler.ActionAny.ActionAny
getActionAny s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionAny.ActionAny)
    val' <- (newPtr Poppler.ActionAny.ActionAny) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionAnyFieldInfo
instance AttrInfo ActionAnyFieldInfo where
    type AttrAllowedOps ActionAnyFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionAnyFieldInfo = (~) (Ptr Poppler.ActionAny.ActionAny)
    type AttrBaseTypeConstraint ActionAnyFieldInfo = (~) Action
    type AttrGetType ActionAnyFieldInfo = Poppler.ActionAny.ActionAny
    type AttrLabel ActionAnyFieldInfo = "any"
    type AttrOrigin ActionAnyFieldInfo = Action
    attrGet _ = getActionAny
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_any :: AttrLabelProxy "any"
action_any = AttrLabelProxy

#endif


getActionGotoDest :: MonadIO m => Action -> m Poppler.ActionGotoDest.ActionGotoDest
getActionGotoDest s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionGotoDest.ActionGotoDest)
    val' <- (newPtr Poppler.ActionGotoDest.ActionGotoDest) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionGotoDestFieldInfo
instance AttrInfo ActionGotoDestFieldInfo where
    type AttrAllowedOps ActionGotoDestFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionGotoDestFieldInfo = (~) (Ptr Poppler.ActionGotoDest.ActionGotoDest)
    type AttrBaseTypeConstraint ActionGotoDestFieldInfo = (~) Action
    type AttrGetType ActionGotoDestFieldInfo = Poppler.ActionGotoDest.ActionGotoDest
    type AttrLabel ActionGotoDestFieldInfo = "goto_dest"
    type AttrOrigin ActionGotoDestFieldInfo = Action
    attrGet _ = getActionGotoDest
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_gotoDest :: AttrLabelProxy "gotoDest"
action_gotoDest = AttrLabelProxy

#endif


getActionGotoRemote :: MonadIO m => Action -> m Poppler.ActionGotoRemote.ActionGotoRemote
getActionGotoRemote s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionGotoRemote.ActionGotoRemote)
    val' <- (newPtr Poppler.ActionGotoRemote.ActionGotoRemote) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionGotoRemoteFieldInfo
instance AttrInfo ActionGotoRemoteFieldInfo where
    type AttrAllowedOps ActionGotoRemoteFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionGotoRemoteFieldInfo = (~) (Ptr Poppler.ActionGotoRemote.ActionGotoRemote)
    type AttrBaseTypeConstraint ActionGotoRemoteFieldInfo = (~) Action
    type AttrGetType ActionGotoRemoteFieldInfo = Poppler.ActionGotoRemote.ActionGotoRemote
    type AttrLabel ActionGotoRemoteFieldInfo = "goto_remote"
    type AttrOrigin ActionGotoRemoteFieldInfo = Action
    attrGet _ = getActionGotoRemote
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_gotoRemote :: AttrLabelProxy "gotoRemote"
action_gotoRemote = AttrLabelProxy

#endif


getActionLaunch :: MonadIO m => Action -> m Poppler.ActionLaunch.ActionLaunch
getActionLaunch s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionLaunch.ActionLaunch)
    val' <- (newPtr Poppler.ActionLaunch.ActionLaunch) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionLaunchFieldInfo
instance AttrInfo ActionLaunchFieldInfo where
    type AttrAllowedOps ActionLaunchFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionLaunchFieldInfo = (~) (Ptr Poppler.ActionLaunch.ActionLaunch)
    type AttrBaseTypeConstraint ActionLaunchFieldInfo = (~) Action
    type AttrGetType ActionLaunchFieldInfo = Poppler.ActionLaunch.ActionLaunch
    type AttrLabel ActionLaunchFieldInfo = "launch"
    type AttrOrigin ActionLaunchFieldInfo = Action
    attrGet _ = getActionLaunch
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_launch :: AttrLabelProxy "launch"
action_launch = AttrLabelProxy

#endif


getActionUri :: MonadIO m => Action -> m Poppler.ActionUri.ActionUri
getActionUri s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionUri.ActionUri)
    val' <- (newPtr Poppler.ActionUri.ActionUri) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionUriFieldInfo
instance AttrInfo ActionUriFieldInfo where
    type AttrAllowedOps ActionUriFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionUriFieldInfo = (~) (Ptr Poppler.ActionUri.ActionUri)
    type AttrBaseTypeConstraint ActionUriFieldInfo = (~) Action
    type AttrGetType ActionUriFieldInfo = Poppler.ActionUri.ActionUri
    type AttrLabel ActionUriFieldInfo = "uri"
    type AttrOrigin ActionUriFieldInfo = Action
    attrGet _ = getActionUri
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_uri :: AttrLabelProxy "uri"
action_uri = AttrLabelProxy

#endif


getActionNamed :: MonadIO m => Action -> m Poppler.ActionNamed.ActionNamed
getActionNamed s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionNamed.ActionNamed)
    val' <- (newPtr Poppler.ActionNamed.ActionNamed) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionNamedFieldInfo
instance AttrInfo ActionNamedFieldInfo where
    type AttrAllowedOps ActionNamedFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionNamedFieldInfo = (~) (Ptr Poppler.ActionNamed.ActionNamed)
    type AttrBaseTypeConstraint ActionNamedFieldInfo = (~) Action
    type AttrGetType ActionNamedFieldInfo = Poppler.ActionNamed.ActionNamed
    type AttrLabel ActionNamedFieldInfo = "named"
    type AttrOrigin ActionNamedFieldInfo = Action
    attrGet _ = getActionNamed
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_named :: AttrLabelProxy "named"
action_named = AttrLabelProxy

#endif


getActionMovie :: MonadIO m => Action -> m Poppler.ActionMovie.ActionMovie
getActionMovie s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionMovie.ActionMovie)
    val' <- (newPtr Poppler.ActionMovie.ActionMovie) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionMovieFieldInfo
instance AttrInfo ActionMovieFieldInfo where
    type AttrAllowedOps ActionMovieFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionMovieFieldInfo = (~) (Ptr Poppler.ActionMovie.ActionMovie)
    type AttrBaseTypeConstraint ActionMovieFieldInfo = (~) Action
    type AttrGetType ActionMovieFieldInfo = Poppler.ActionMovie.ActionMovie
    type AttrLabel ActionMovieFieldInfo = "movie"
    type AttrOrigin ActionMovieFieldInfo = Action
    attrGet _ = getActionMovie
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_movie :: AttrLabelProxy "movie"
action_movie = AttrLabelProxy

#endif


getActionRendition :: MonadIO m => Action -> m Poppler.ActionRendition.ActionRendition
getActionRendition s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionRendition.ActionRendition)
    val' <- (newPtr Poppler.ActionRendition.ActionRendition) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionRenditionFieldInfo
instance AttrInfo ActionRenditionFieldInfo where
    type AttrAllowedOps ActionRenditionFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionRenditionFieldInfo = (~) (Ptr Poppler.ActionRendition.ActionRendition)
    type AttrBaseTypeConstraint ActionRenditionFieldInfo = (~) Action
    type AttrGetType ActionRenditionFieldInfo = Poppler.ActionRendition.ActionRendition
    type AttrLabel ActionRenditionFieldInfo = "rendition"
    type AttrOrigin ActionRenditionFieldInfo = Action
    attrGet _ = getActionRendition
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_rendition :: AttrLabelProxy "rendition"
action_rendition = AttrLabelProxy

#endif


getActionOcgState :: MonadIO m => Action -> m Poppler.ActionOCGState.ActionOCGState
getActionOcgState s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionOCGState.ActionOCGState)
    val' <- (newPtr Poppler.ActionOCGState.ActionOCGState) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionOcgStateFieldInfo
instance AttrInfo ActionOcgStateFieldInfo where
    type AttrAllowedOps ActionOcgStateFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionOcgStateFieldInfo = (~) (Ptr Poppler.ActionOCGState.ActionOCGState)
    type AttrBaseTypeConstraint ActionOcgStateFieldInfo = (~) Action
    type AttrGetType ActionOcgStateFieldInfo = Poppler.ActionOCGState.ActionOCGState
    type AttrLabel ActionOcgStateFieldInfo = "ocg_state"
    type AttrOrigin ActionOcgStateFieldInfo = Action
    attrGet _ = getActionOcgState
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_ocgState :: AttrLabelProxy "ocgState"
action_ocgState = AttrLabelProxy

#endif


getActionJavascript :: MonadIO m => Action -> m Poppler.ActionJavascript.ActionJavascript
getActionJavascript s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Poppler.ActionJavascript.ActionJavascript)
    val' <- (newPtr Poppler.ActionJavascript.ActionJavascript) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data ActionJavascriptFieldInfo
instance AttrInfo ActionJavascriptFieldInfo where
    type AttrAllowedOps ActionJavascriptFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ActionJavascriptFieldInfo = (~) (Ptr Poppler.ActionJavascript.ActionJavascript)
    type AttrBaseTypeConstraint ActionJavascriptFieldInfo = (~) Action
    type AttrGetType ActionJavascriptFieldInfo = Poppler.ActionJavascript.ActionJavascript
    type AttrLabel ActionJavascriptFieldInfo = "javascript"
    type AttrOrigin ActionJavascriptFieldInfo = Action
    attrGet _ = getActionJavascript
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

action_javascript :: AttrLabelProxy "javascript"
action_javascript = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList Action
type instance O.AttributeList Action = ActionAttributeList
type ActionAttributeList = ('[ '("type", ActionTypeFieldInfo), '("any", ActionAnyFieldInfo), '("gotoDest", ActionGotoDestFieldInfo), '("gotoRemote", ActionGotoRemoteFieldInfo), '("launch", ActionLaunchFieldInfo), '("uri", ActionUriFieldInfo), '("named", ActionNamedFieldInfo), '("movie", ActionMovieFieldInfo), '("rendition", ActionRenditionFieldInfo), '("ocgState", ActionOcgStateFieldInfo), '("javascript", ActionJavascriptFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "poppler_action_copy" poppler_action_copy :: 
    Ptr Action ->                           -- action : TInterface (Name {namespace = "Poppler", name = "Action"})
    IO (Ptr Action)

{- |
Copies /@action@/, creating an identical 'GI.Poppler.Unions.Action.Action'.
-}
actionCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Action
    {- ^ /@action@/: a 'GI.Poppler.Unions.Action.Action' -}
    -> m Action
    {- ^ __Returns:__ a new action identical to /@action@/ -}
actionCopy action = liftIO $ do
    action' <- unsafeManagedPtrGetPtr action
    result <- poppler_action_copy action'
    checkUnexpectedReturnNULL "actionCopy" result
    result' <- (wrapBoxed Action) result
    touchManagedPtr action
    return result'

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

#endif

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

foreign import ccall "poppler_action_free" poppler_action_free :: 
    Ptr Action ->                           -- action : TInterface (Name {namespace = "Poppler", name = "Action"})
    IO ()

{- |
Frees /@action@/
-}
actionFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Action
    {- ^ /@action@/: a 'GI.Poppler.Unions.Action.Action' -}
    -> m ()
actionFree action = liftIO $ do
    action' <- unsafeManagedPtrGetPtr action
    poppler_action_free action'
    touchManagedPtr action
    return ()

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

#endif

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

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

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveActionMethod t Action, O.MethodInfo info Action p) => O.IsLabel t (Action -> 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