{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A data structure for holding actions

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

module GI.Poppler.Unions.Action
    ( 

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


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

#if defined(ENABLE_OVERLOADING)
    ResolveActionMethod                     ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    ActionCopyMethodInfo                    ,
#endif
    actionCopy                              ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    ActionFreeMethodInfo                    ,
#endif
    actionFree                              ,




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

#if defined(ENABLE_OVERLOADING)
    action_any                              ,
#endif
    getActionAny                            ,


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

#if defined(ENABLE_OVERLOADING)
    action_gotoDest                         ,
#endif
    getActionGotoDest                       ,


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

#if defined(ENABLE_OVERLOADING)
    action_gotoRemote                       ,
#endif
    getActionGotoRemote                     ,


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

#if defined(ENABLE_OVERLOADING)
    action_javascript                       ,
#endif
    getActionJavascript                     ,


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

#if defined(ENABLE_OVERLOADING)
    action_launch                           ,
#endif
    getActionLaunch                         ,


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

#if defined(ENABLE_OVERLOADING)
    action_movie                            ,
#endif
    getActionMovie                          ,


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

#if defined(ENABLE_OVERLOADING)
    action_named                            ,
#endif
    getActionNamed                          ,


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

#if defined(ENABLE_OVERLOADING)
    action_ocgState                         ,
#endif
    getActionOcgState                       ,


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

#if defined(ENABLE_OVERLOADING)
    action_rendition                        ,
#endif
    getActionRendition                      ,


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

#if defined(ENABLE_OVERLOADING)
    action_type                             ,
#endif
    getActionType                           ,
    setActionType                           ,


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

#if defined(ENABLE_OVERLOADING)
    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.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 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 {-# 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

-- | Memory-managed wrapper type.
newtype Action = Action (ManagedPtr Action)
    deriving (Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq)
foreign import ccall "poppler_action_get_type" c_poppler_action_get_type :: 
    IO GType

instance BoxedObject Action where
    boxedType :: Action -> IO GType
boxedType _ = IO GType
c_poppler_action_get_type

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

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

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


-- | A convenience alias for `Nothing` :: `Maybe` `Action`.
noAction :: Maybe Action
noAction :: Maybe Action
noAction = Maybe Action
forall a. Maybe a
Nothing

-- | Get the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #type
-- @
getActionType :: MonadIO m => Action -> m Poppler.Enums.ActionType
getActionType :: Action -> m ActionType
getActionType s :: Action
s = IO ActionType -> m ActionType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionType -> m ActionType) -> IO ActionType -> m ActionType
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionType) -> IO ActionType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionType) -> IO ActionType)
-> (Ptr Action -> IO ActionType) -> IO ActionType
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Action
ptr Ptr Action -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO CUInt
    let val' :: ActionType
val' = (Int -> ActionType
forall a. Enum a => Int -> a
toEnum (Int -> ActionType) -> (CUInt -> Int) -> CUInt -> ActionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    ActionType -> IO ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
val'

-- | Set the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' action [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionType :: MonadIO m => Action -> Poppler.Enums.ActionType -> m ()
setActionType :: Action -> ActionType -> m ()
setActionType s :: Action
s val :: ActionType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ActionType -> Int) -> ActionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionType -> Int
forall a. Enum a => a -> Int
fromEnum) ActionType
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Action
ptr Ptr Action -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data ActionTypeFieldInfo
instance AttrInfo ActionTypeFieldInfo where
    type AttrBaseTypeConstraint ActionTypeFieldInfo = (~) Action
    type AttrAllowedOps ActionTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionTypeFieldInfo = (~) Poppler.Enums.ActionType
    type AttrTransferTypeConstraint ActionTypeFieldInfo = (~)Poppler.Enums.ActionType
    type AttrTransferType ActionTypeFieldInfo = Poppler.Enums.ActionType
    type AttrGetType ActionTypeFieldInfo = Poppler.Enums.ActionType
    type AttrLabel ActionTypeFieldInfo = "type"
    type AttrOrigin ActionTypeFieldInfo = Action
    attrGet = getActionType
    attrSet = setActionType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

action_type :: AttrLabelProxy "type"
action_type = AttrLabelProxy

#endif


-- | Get the value of the “@any@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #any
-- @
getActionAny :: MonadIO m => Action -> m Poppler.ActionAny.ActionAny
getActionAny :: Action -> m ActionAny
getActionAny s :: Action
s = IO ActionAny -> m ActionAny
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionAny -> m ActionAny) -> IO ActionAny -> m ActionAny
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionAny) -> IO ActionAny
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionAny) -> IO ActionAny)
-> (Ptr Action -> IO ActionAny) -> IO ActionAny
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionAny
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionAny
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionAny.ActionAny)
    ActionAny
val' <- ((ManagedPtr ActionAny -> ActionAny)
-> Ptr ActionAny -> IO ActionAny
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionAny -> ActionAny
Poppler.ActionAny.ActionAny) Ptr ActionAny
val
    ActionAny -> IO ActionAny
forall (m :: * -> *) a. Monad m => a -> m a
return ActionAny
val'

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

action_any :: AttrLabelProxy "any"
action_any = AttrLabelProxy

#endif


-- | Get the value of the “@goto_dest@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #gotoDest
-- @
getActionGotoDest :: MonadIO m => Action -> m Poppler.ActionGotoDest.ActionGotoDest
getActionGotoDest :: Action -> m ActionGotoDest
getActionGotoDest s :: Action
s = IO ActionGotoDest -> m ActionGotoDest
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionGotoDest -> m ActionGotoDest)
-> IO ActionGotoDest -> m ActionGotoDest
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionGotoDest) -> IO ActionGotoDest
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionGotoDest) -> IO ActionGotoDest)
-> (Ptr Action -> IO ActionGotoDest) -> IO ActionGotoDest
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionGotoDest
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionGotoDest
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionGotoDest.ActionGotoDest)
    ActionGotoDest
val' <- ((ManagedPtr ActionGotoDest -> ActionGotoDest)
-> Ptr ActionGotoDest -> IO ActionGotoDest
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionGotoDest -> ActionGotoDest
Poppler.ActionGotoDest.ActionGotoDest) Ptr ActionGotoDest
val
    ActionGotoDest -> IO ActionGotoDest
forall (m :: * -> *) a. Monad m => a -> m a
return ActionGotoDest
val'

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

action_gotoDest :: AttrLabelProxy "gotoDest"
action_gotoDest = AttrLabelProxy

#endif


-- | Get the value of the “@goto_remote@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #gotoRemote
-- @
getActionGotoRemote :: MonadIO m => Action -> m Poppler.ActionGotoRemote.ActionGotoRemote
getActionGotoRemote :: Action -> m ActionGotoRemote
getActionGotoRemote s :: Action
s = IO ActionGotoRemote -> m ActionGotoRemote
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionGotoRemote -> m ActionGotoRemote)
-> IO ActionGotoRemote -> m ActionGotoRemote
forall a b. (a -> b) -> a -> b
$ Action
-> (Ptr Action -> IO ActionGotoRemote) -> IO ActionGotoRemote
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionGotoRemote) -> IO ActionGotoRemote)
-> (Ptr Action -> IO ActionGotoRemote) -> IO ActionGotoRemote
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionGotoRemote
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionGotoRemote
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionGotoRemote.ActionGotoRemote)
    ActionGotoRemote
val' <- ((ManagedPtr ActionGotoRemote -> ActionGotoRemote)
-> Ptr ActionGotoRemote -> IO ActionGotoRemote
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionGotoRemote -> ActionGotoRemote
Poppler.ActionGotoRemote.ActionGotoRemote) Ptr ActionGotoRemote
val
    ActionGotoRemote -> IO ActionGotoRemote
forall (m :: * -> *) a. Monad m => a -> m a
return ActionGotoRemote
val'

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

action_gotoRemote :: AttrLabelProxy "gotoRemote"
action_gotoRemote = AttrLabelProxy

#endif


-- | Get the value of the “@launch@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #launch
-- @
getActionLaunch :: MonadIO m => Action -> m Poppler.ActionLaunch.ActionLaunch
getActionLaunch :: Action -> m ActionLaunch
getActionLaunch s :: Action
s = IO ActionLaunch -> m ActionLaunch
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionLaunch -> m ActionLaunch)
-> IO ActionLaunch -> m ActionLaunch
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionLaunch) -> IO ActionLaunch
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionLaunch) -> IO ActionLaunch)
-> (Ptr Action -> IO ActionLaunch) -> IO ActionLaunch
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionLaunch
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionLaunch
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionLaunch.ActionLaunch)
    ActionLaunch
val' <- ((ManagedPtr ActionLaunch -> ActionLaunch)
-> Ptr ActionLaunch -> IO ActionLaunch
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionLaunch -> ActionLaunch
Poppler.ActionLaunch.ActionLaunch) Ptr ActionLaunch
val
    ActionLaunch -> IO ActionLaunch
forall (m :: * -> *) a. Monad m => a -> m a
return ActionLaunch
val'

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

action_launch :: AttrLabelProxy "launch"
action_launch = AttrLabelProxy

#endif


-- | Get the value of the “@uri@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #uri
-- @
getActionUri :: MonadIO m => Action -> m Poppler.ActionUri.ActionUri
getActionUri :: Action -> m ActionUri
getActionUri s :: Action
s = IO ActionUri -> m ActionUri
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionUri -> m ActionUri) -> IO ActionUri -> m ActionUri
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionUri) -> IO ActionUri
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionUri) -> IO ActionUri)
-> (Ptr Action -> IO ActionUri) -> IO ActionUri
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionUri
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionUri
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionUri.ActionUri)
    ActionUri
val' <- ((ManagedPtr ActionUri -> ActionUri)
-> Ptr ActionUri -> IO ActionUri
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionUri -> ActionUri
Poppler.ActionUri.ActionUri) Ptr ActionUri
val
    ActionUri -> IO ActionUri
forall (m :: * -> *) a. Monad m => a -> m a
return ActionUri
val'

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

action_uri :: AttrLabelProxy "uri"
action_uri = AttrLabelProxy

#endif


-- | Get the value of the “@named@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #named
-- @
getActionNamed :: MonadIO m => Action -> m Poppler.ActionNamed.ActionNamed
getActionNamed :: Action -> m ActionNamed
getActionNamed s :: Action
s = IO ActionNamed -> m ActionNamed
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionNamed -> m ActionNamed)
-> IO ActionNamed -> m ActionNamed
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionNamed) -> IO ActionNamed
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionNamed) -> IO ActionNamed)
-> (Ptr Action -> IO ActionNamed) -> IO ActionNamed
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionNamed
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionNamed
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionNamed.ActionNamed)
    ActionNamed
val' <- ((ManagedPtr ActionNamed -> ActionNamed)
-> Ptr ActionNamed -> IO ActionNamed
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionNamed -> ActionNamed
Poppler.ActionNamed.ActionNamed) Ptr ActionNamed
val
    ActionNamed -> IO ActionNamed
forall (m :: * -> *) a. Monad m => a -> m a
return ActionNamed
val'

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

action_named :: AttrLabelProxy "named"
action_named = AttrLabelProxy

#endif


-- | Get the value of the “@movie@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #movie
-- @
getActionMovie :: MonadIO m => Action -> m Poppler.ActionMovie.ActionMovie
getActionMovie :: Action -> m ActionMovie
getActionMovie s :: Action
s = IO ActionMovie -> m ActionMovie
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionMovie -> m ActionMovie)
-> IO ActionMovie -> m ActionMovie
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionMovie) -> IO ActionMovie
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionMovie) -> IO ActionMovie)
-> (Ptr Action -> IO ActionMovie) -> IO ActionMovie
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionMovie
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionMovie
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionMovie.ActionMovie)
    ActionMovie
val' <- ((ManagedPtr ActionMovie -> ActionMovie)
-> Ptr ActionMovie -> IO ActionMovie
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionMovie -> ActionMovie
Poppler.ActionMovie.ActionMovie) Ptr ActionMovie
val
    ActionMovie -> IO ActionMovie
forall (m :: * -> *) a. Monad m => a -> m a
return ActionMovie
val'

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

action_movie :: AttrLabelProxy "movie"
action_movie = AttrLabelProxy

#endif


-- | Get the value of the “@rendition@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #rendition
-- @
getActionRendition :: MonadIO m => Action -> m Poppler.ActionRendition.ActionRendition
getActionRendition :: Action -> m ActionRendition
getActionRendition s :: Action
s = IO ActionRendition -> m ActionRendition
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionRendition -> m ActionRendition)
-> IO ActionRendition -> m ActionRendition
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionRendition) -> IO ActionRendition
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionRendition) -> IO ActionRendition)
-> (Ptr Action -> IO ActionRendition) -> IO ActionRendition
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionRendition
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionRendition
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionRendition.ActionRendition)
    ActionRendition
val' <- ((ManagedPtr ActionRendition -> ActionRendition)
-> Ptr ActionRendition -> IO ActionRendition
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionRendition -> ActionRendition
Poppler.ActionRendition.ActionRendition) Ptr ActionRendition
val
    ActionRendition -> IO ActionRendition
forall (m :: * -> *) a. Monad m => a -> m a
return ActionRendition
val'

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

action_rendition :: AttrLabelProxy "rendition"
action_rendition = AttrLabelProxy

#endif


-- | Get the value of the “@ocg_state@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #ocgState
-- @
getActionOcgState :: MonadIO m => Action -> m Poppler.ActionOCGState.ActionOCGState
getActionOcgState :: Action -> m ActionOCGState
getActionOcgState s :: Action
s = IO ActionOCGState -> m ActionOCGState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionOCGState -> m ActionOCGState)
-> IO ActionOCGState -> m ActionOCGState
forall a b. (a -> b) -> a -> b
$ Action -> (Ptr Action -> IO ActionOCGState) -> IO ActionOCGState
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionOCGState) -> IO ActionOCGState)
-> (Ptr Action -> IO ActionOCGState) -> IO ActionOCGState
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionOCGState
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionOCGState
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionOCGState.ActionOCGState)
    ActionOCGState
val' <- ((ManagedPtr ActionOCGState -> ActionOCGState)
-> Ptr ActionOCGState -> IO ActionOCGState
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionOCGState -> ActionOCGState
Poppler.ActionOCGState.ActionOCGState) Ptr ActionOCGState
val
    ActionOCGState -> IO ActionOCGState
forall (m :: * -> *) a. Monad m => a -> m a
return ActionOCGState
val'

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

action_ocgState :: AttrLabelProxy "ocgState"
action_ocgState = AttrLabelProxy

#endif


-- | Get the value of the “@javascript@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' action #javascript
-- @
getActionJavascript :: MonadIO m => Action -> m Poppler.ActionJavascript.ActionJavascript
getActionJavascript :: Action -> m ActionJavascript
getActionJavascript s :: Action
s = IO ActionJavascript -> m ActionJavascript
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionJavascript -> m ActionJavascript)
-> IO ActionJavascript -> m ActionJavascript
forall a b. (a -> b) -> a -> b
$ Action
-> (Ptr Action -> IO ActionJavascript) -> IO ActionJavascript
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Action
s ((Ptr Action -> IO ActionJavascript) -> IO ActionJavascript)
-> (Ptr Action -> IO ActionJavascript) -> IO ActionJavascript
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Action
ptr -> do
    let val :: Ptr ActionJavascript
val = Ptr Action
ptr Ptr Action -> Int -> Ptr ActionJavascript
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Poppler.ActionJavascript.ActionJavascript)
    ActionJavascript
val' <- ((ManagedPtr ActionJavascript -> ActionJavascript)
-> Ptr ActionJavascript -> IO ActionJavascript
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr ActionJavascript -> ActionJavascript
Poppler.ActionJavascript.ActionJavascript) Ptr ActionJavascript
val
    ActionJavascript -> IO ActionJavascript
forall (m :: * -> *) a. Monad m => a -> m a
return ActionJavascript
val'

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

action_javascript :: AttrLabelProxy "javascript"
action_javascript = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
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 t'GI.Poppler.Unions.Action.Action'.
actionCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Action
    -- ^ /@action@/: a t'GI.Poppler.Unions.Action.Action'
    -> m Action
    -- ^ __Returns:__ a new action identical to /@action@/
actionCopy :: Action -> m Action
actionCopy action :: Action
action = IO Action -> m Action
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Action -> m Action) -> IO Action -> m Action
forall a b. (a -> b) -> a -> b
$ do
    Ptr Action
action' <- Action -> IO (Ptr Action)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Action
action
    Ptr Action
result <- Ptr Action -> IO (Ptr Action)
poppler_action_copy Ptr Action
action'
    Text -> Ptr Action -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "actionCopy" Ptr Action
result
    Action
result' <- ((ManagedPtr Action -> Action) -> Ptr Action -> IO Action
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Action -> Action
Action) Ptr Action
result
    Action -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Action
action
    Action -> IO Action
forall (m :: * -> *) a. Monad m => a -> m a
return Action
result'

#if defined(ENABLE_OVERLOADING)
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 t'GI.Poppler.Unions.Action.Action'
    -> m ()
actionFree :: Action -> m ()
actionFree action :: Action
action = 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 Action
action' <- Action -> IO (Ptr Action)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Action
action
    Ptr Action -> IO ()
poppler_action_free Ptr Action
action'
    Action -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Action
action
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

#if defined(ENABLE_OVERLOADING)
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) => OL.IsLabel t (Action -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif