{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Go to destination

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

module GI.Poppler.Structs.ActionGotoDest
    ( 

-- * Exported types
    ActionGotoDest(..)                      ,
    newZeroActionGotoDest                   ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveActionGotoDestMethod             ,
#endif



 -- * Properties


-- ** dest #attr:dest#
-- | destination

#if defined(ENABLE_OVERLOADING)
    actionGotoDest_dest                     ,
#endif
    clearActionGotoDestDest                 ,
    getActionGotoDestDest                   ,
    setActionGotoDestDest                   ,


-- ** title #attr:title#
-- | action title

#if defined(ENABLE_OVERLOADING)
    actionGotoDest_title                    ,
#endif
    clearActionGotoDestTitle                ,
    getActionGotoDestTitle                  ,
    setActionGotoDestTitle                  ,


-- ** type #attr:type#
-- | action type ('GI.Poppler.Enums.ActionTypeGotoDest')

#if defined(ENABLE_OVERLOADING)
    actionGotoDest_type                     ,
#endif
    getActionGotoDestType                   ,
    setActionGotoDestType                   ,




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

import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Structs.Dest as Poppler.Dest

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

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

instance BoxedPtr ActionGotoDest where
    boxedPtrCopy :: ActionGotoDest -> IO ActionGotoDest
boxedPtrCopy = \ActionGotoDest
p -> ActionGotoDest
-> (Ptr ActionGotoDest -> IO ActionGotoDest) -> IO ActionGotoDest
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ActionGotoDest
p (Int -> Ptr ActionGotoDest -> IO (Ptr ActionGotoDest)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
24 (Ptr ActionGotoDest -> IO (Ptr ActionGotoDest))
-> (Ptr ActionGotoDest -> IO ActionGotoDest)
-> Ptr ActionGotoDest
-> IO ActionGotoDest
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ActionGotoDest -> ActionGotoDest)
-> Ptr ActionGotoDest -> IO ActionGotoDest
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr ActionGotoDest -> ActionGotoDest
ActionGotoDest)
    boxedPtrFree :: ActionGotoDest -> IO ()
boxedPtrFree = \ActionGotoDest
x -> ActionGotoDest -> (Ptr ActionGotoDest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr ActionGotoDest
x Ptr ActionGotoDest -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr ActionGotoDest where
    boxedPtrCalloc :: IO (Ptr ActionGotoDest)
boxedPtrCalloc = Int -> IO (Ptr ActionGotoDest)
forall a. Int -> IO (Ptr a)
callocBytes Int
24


-- | Construct a `ActionGotoDest` struct initialized to zero.
newZeroActionGotoDest :: MonadIO m => m ActionGotoDest
newZeroActionGotoDest :: forall (m :: * -> *). MonadIO m => m ActionGotoDest
newZeroActionGotoDest = 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
$ IO (Ptr ActionGotoDest)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr ActionGotoDest)
-> (Ptr ActionGotoDest -> IO ActionGotoDest) -> IO ActionGotoDest
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ActionGotoDest -> ActionGotoDest)
-> Ptr ActionGotoDest -> IO ActionGotoDest
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ActionGotoDest -> ActionGotoDest
ActionGotoDest

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


-- | 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' actionGotoDest #type
-- @
getActionGotoDestType :: MonadIO m => ActionGotoDest -> m Poppler.Enums.ActionType
getActionGotoDestType :: forall (m :: * -> *). MonadIO m => ActionGotoDest -> m ActionType
getActionGotoDestType ActionGotoDest
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
$ ActionGotoDest
-> (Ptr ActionGotoDest -> IO ActionType) -> IO ActionType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoDest
s ((Ptr ActionGotoDest -> IO ActionType) -> IO ActionType)
-> (Ptr ActionGotoDest -> IO ActionType) -> IO ActionType
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGotoDest
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionGotoDest
ptr Ptr ActionGotoDest -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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' actionGotoDest [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionGotoDestType :: MonadIO m => ActionGotoDest -> Poppler.Enums.ActionType -> m ()
setActionGotoDestType :: forall (m :: * -> *).
MonadIO m =>
ActionGotoDest -> ActionType -> m ()
setActionGotoDestType ActionGotoDest
s 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
$ ActionGotoDest -> (Ptr ActionGotoDest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoDest
s ((Ptr ActionGotoDest -> IO ()) -> IO ())
-> (Ptr ActionGotoDest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGotoDest
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 ActionGotoDest
ptr Ptr ActionGotoDest -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data ActionGotoDestTypeFieldInfo
instance AttrInfo ActionGotoDestTypeFieldInfo where
    type AttrBaseTypeConstraint ActionGotoDestTypeFieldInfo = (~) ActionGotoDest
    type AttrAllowedOps ActionGotoDestTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionGotoDestTypeFieldInfo = (~) Poppler.Enums.ActionType
    type AttrTransferTypeConstraint ActionGotoDestTypeFieldInfo = (~)Poppler.Enums.ActionType
    type AttrTransferType ActionGotoDestTypeFieldInfo = Poppler.Enums.ActionType
    type AttrGetType ActionGotoDestTypeFieldInfo = Poppler.Enums.ActionType
    type AttrLabel ActionGotoDestTypeFieldInfo = "type"
    type AttrOrigin ActionGotoDestTypeFieldInfo = ActionGotoDest
    attrGet = getActionGotoDestType
    attrSet = setActionGotoDestType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.ActionGotoDest.type"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-ActionGotoDest.html#g:attr:type"
        })

actionGotoDest_type :: AttrLabelProxy "type"
actionGotoDest_type = AttrLabelProxy

#endif


-- | Get the value of the “@title@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionGotoDest #title
-- @
getActionGotoDestTitle :: MonadIO m => ActionGotoDest -> m (Maybe T.Text)
getActionGotoDestTitle :: forall (m :: * -> *). MonadIO m => ActionGotoDest -> m (Maybe Text)
getActionGotoDestTitle ActionGotoDest
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ActionGotoDest
-> (Ptr ActionGotoDest -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoDest
s ((Ptr ActionGotoDest -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionGotoDest -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGotoDest
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionGotoDest
ptr Ptr ActionGotoDest -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@title@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #title
-- @
clearActionGotoDestTitle :: MonadIO m => ActionGotoDest -> m ()
clearActionGotoDestTitle :: forall (m :: * -> *). MonadIO m => ActionGotoDest -> m ()
clearActionGotoDestTitle ActionGotoDest
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionGotoDest -> (Ptr ActionGotoDest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoDest
s ((Ptr ActionGotoDest -> IO ()) -> IO ())
-> (Ptr ActionGotoDest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGotoDest
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionGotoDest
ptr Ptr ActionGotoDest -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ActionGotoDestTitleFieldInfo
instance AttrInfo ActionGotoDestTitleFieldInfo where
    type AttrBaseTypeConstraint ActionGotoDestTitleFieldInfo = (~) ActionGotoDest
    type AttrAllowedOps ActionGotoDestTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionGotoDestTitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionGotoDestTitleFieldInfo = (~)CString
    type AttrTransferType ActionGotoDestTitleFieldInfo = CString
    type AttrGetType ActionGotoDestTitleFieldInfo = Maybe T.Text
    type AttrLabel ActionGotoDestTitleFieldInfo = "title"
    type AttrOrigin ActionGotoDestTitleFieldInfo = ActionGotoDest
    attrGet = getActionGotoDestTitle
    attrSet = setActionGotoDestTitle
    attrConstruct = undefined
    attrClear = clearActionGotoDestTitle
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.ActionGotoDest.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-ActionGotoDest.html#g:attr:title"
        })

actionGotoDest_title :: AttrLabelProxy "title"
actionGotoDest_title = AttrLabelProxy

#endif


-- | Get the value of the “@dest@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionGotoDest #dest
-- @
getActionGotoDestDest :: MonadIO m => ActionGotoDest -> m (Maybe Poppler.Dest.Dest)
getActionGotoDestDest :: forall (m :: * -> *). MonadIO m => ActionGotoDest -> m (Maybe Dest)
getActionGotoDestDest ActionGotoDest
s = IO (Maybe Dest) -> m (Maybe Dest)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Dest) -> m (Maybe Dest))
-> IO (Maybe Dest) -> m (Maybe Dest)
forall a b. (a -> b) -> a -> b
$ ActionGotoDest
-> (Ptr ActionGotoDest -> IO (Maybe Dest)) -> IO (Maybe Dest)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoDest
s ((Ptr ActionGotoDest -> IO (Maybe Dest)) -> IO (Maybe Dest))
-> (Ptr ActionGotoDest -> IO (Maybe Dest)) -> IO (Maybe Dest)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGotoDest
ptr -> do
    Ptr Dest
val <- Ptr (Ptr Dest) -> IO (Ptr Dest)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionGotoDest
ptr Ptr ActionGotoDest -> Int -> Ptr (Ptr Dest)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (Ptr Poppler.Dest.Dest)
    Maybe Dest
result <- Ptr Dest -> (Ptr Dest -> IO Dest) -> IO (Maybe Dest)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Dest
val ((Ptr Dest -> IO Dest) -> IO (Maybe Dest))
-> (Ptr Dest -> IO Dest) -> IO (Maybe Dest)
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
val' -> do
        Dest
val'' <- ((ManagedPtr Dest -> Dest) -> Ptr Dest -> IO Dest
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Dest -> Dest
Poppler.Dest.Dest) Ptr Dest
val'
        Dest -> IO Dest
forall (m :: * -> *) a. Monad m => a -> m a
return Dest
val''
    Maybe Dest -> IO (Maybe Dest)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Dest
result

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

-- | Set the value of the “@dest@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #dest
-- @
clearActionGotoDestDest :: MonadIO m => ActionGotoDest -> m ()
clearActionGotoDestDest :: forall (m :: * -> *). MonadIO m => ActionGotoDest -> m ()
clearActionGotoDestDest ActionGotoDest
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionGotoDest -> (Ptr ActionGotoDest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoDest
s ((Ptr ActionGotoDest -> IO ()) -> IO ())
-> (Ptr ActionGotoDest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGotoDest
ptr -> do
    Ptr (Ptr Dest) -> Ptr Dest -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionGotoDest
ptr Ptr ActionGotoDest -> Int -> Ptr (Ptr Dest)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr Dest
forall a. Ptr a
FP.nullPtr :: Ptr Poppler.Dest.Dest)

#if defined(ENABLE_OVERLOADING)
data ActionGotoDestDestFieldInfo
instance AttrInfo ActionGotoDestDestFieldInfo where
    type AttrBaseTypeConstraint ActionGotoDestDestFieldInfo = (~) ActionGotoDest
    type AttrAllowedOps ActionGotoDestDestFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionGotoDestDestFieldInfo = (~) (Ptr Poppler.Dest.Dest)
    type AttrTransferTypeConstraint ActionGotoDestDestFieldInfo = (~)(Ptr Poppler.Dest.Dest)
    type AttrTransferType ActionGotoDestDestFieldInfo = (Ptr Poppler.Dest.Dest)
    type AttrGetType ActionGotoDestDestFieldInfo = Maybe Poppler.Dest.Dest
    type AttrLabel ActionGotoDestDestFieldInfo = "dest"
    type AttrOrigin ActionGotoDestDestFieldInfo = ActionGotoDest
    attrGet = getActionGotoDestDest
    attrSet = setActionGotoDestDest
    attrConstruct = undefined
    attrClear = clearActionGotoDestDest
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.ActionGotoDest.dest"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-ActionGotoDest.html#g:attr:dest"
        })

actionGotoDest_dest :: AttrLabelProxy "dest"
actionGotoDest_dest = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionGotoDest
type instance O.AttributeList ActionGotoDest = ActionGotoDestAttributeList
type ActionGotoDestAttributeList = ('[ '("type", ActionGotoDestTypeFieldInfo), '("title", ActionGotoDestTitleFieldInfo), '("dest", ActionGotoDestDestFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveActionGotoDestMethod (t :: Symbol) (o :: *) :: * where
    ResolveActionGotoDestMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif