{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Poppler.Structs.ActionGotoRemote
    ( 

-- * Exported types
    ActionGotoRemote(..)                    ,
    newZeroActionGotoRemote                 ,
    noActionGotoRemote                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveActionGotoRemoteMethod           ,
#endif




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

#if defined(ENABLE_OVERLOADING)
    actionGotoRemote_dest                   ,
#endif
    clearActionGotoRemoteDest               ,
    getActionGotoRemoteDest                 ,
    setActionGotoRemoteDest                 ,


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

#if defined(ENABLE_OVERLOADING)
    actionGotoRemote_fileName               ,
#endif
    clearActionGotoRemoteFileName           ,
    getActionGotoRemoteFileName             ,
    setActionGotoRemoteFileName             ,


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

#if defined(ENABLE_OVERLOADING)
    actionGotoRemote_title                  ,
#endif
    clearActionGotoRemoteTitle              ,
    getActionGotoRemoteTitle                ,
    setActionGotoRemoteTitle                ,


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

#if defined(ENABLE_OVERLOADING)
    actionGotoRemote_type                   ,
#endif
    getActionGotoRemoteType                 ,
    setActionGotoRemoteType                 ,




    ) 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.Dest as Poppler.Dest

-- | Memory-managed wrapper type.
newtype ActionGotoRemote = ActionGotoRemote (ManagedPtr ActionGotoRemote)
    deriving (ActionGotoRemote -> ActionGotoRemote -> Bool
(ActionGotoRemote -> ActionGotoRemote -> Bool)
-> (ActionGotoRemote -> ActionGotoRemote -> Bool)
-> Eq ActionGotoRemote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionGotoRemote -> ActionGotoRemote -> Bool
$c/= :: ActionGotoRemote -> ActionGotoRemote -> Bool
== :: ActionGotoRemote -> ActionGotoRemote -> Bool
$c== :: ActionGotoRemote -> ActionGotoRemote -> Bool
Eq)
instance WrappedPtr ActionGotoRemote where
    wrappedPtrCalloc :: IO (Ptr ActionGotoRemote)
wrappedPtrCalloc = Int -> IO (Ptr ActionGotoRemote)
forall a. Int -> IO (Ptr a)
callocBytes 32
    wrappedPtrCopy :: ActionGotoRemote -> IO ActionGotoRemote
wrappedPtrCopy = \p :: ActionGotoRemote
p -> ActionGotoRemote
-> (Ptr ActionGotoRemote -> IO ActionGotoRemote)
-> IO ActionGotoRemote
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
p (Int -> Ptr ActionGotoRemote -> IO (Ptr ActionGotoRemote)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 32 (Ptr ActionGotoRemote -> IO (Ptr ActionGotoRemote))
-> (Ptr ActionGotoRemote -> IO ActionGotoRemote)
-> Ptr ActionGotoRemote
-> IO ActionGotoRemote
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ActionGotoRemote -> ActionGotoRemote)
-> Ptr ActionGotoRemote -> IO ActionGotoRemote
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ActionGotoRemote -> ActionGotoRemote
ActionGotoRemote)
    wrappedPtrFree :: Maybe (GDestroyNotify ActionGotoRemote)
wrappedPtrFree = GDestroyNotify ActionGotoRemote
-> Maybe (GDestroyNotify ActionGotoRemote)
forall a. a -> Maybe a
Just GDestroyNotify ActionGotoRemote
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `ActionGotoRemote` struct initialized to zero.
newZeroActionGotoRemote :: MonadIO m => m ActionGotoRemote
newZeroActionGotoRemote :: m ActionGotoRemote
newZeroActionGotoRemote = 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
$ IO (Ptr ActionGotoRemote)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr ActionGotoRemote)
-> (Ptr ActionGotoRemote -> IO ActionGotoRemote)
-> IO ActionGotoRemote
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ActionGotoRemote -> ActionGotoRemote)
-> Ptr ActionGotoRemote -> IO ActionGotoRemote
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ActionGotoRemote -> ActionGotoRemote
ActionGotoRemote

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


-- | A convenience alias for `Nothing` :: `Maybe` `ActionGotoRemote`.
noActionGotoRemote :: Maybe ActionGotoRemote
noActionGotoRemote :: Maybe ActionGotoRemote
noActionGotoRemote = Maybe ActionGotoRemote
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' actionGotoRemote #type
-- @
getActionGotoRemoteType :: MonadIO m => ActionGotoRemote -> m Poppler.Enums.ActionType
getActionGotoRemoteType :: ActionGotoRemote -> m ActionType
getActionGotoRemoteType s :: ActionGotoRemote
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
$ ActionGotoRemote
-> (Ptr ActionGotoRemote -> IO ActionType) -> IO ActionType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO ActionType) -> IO ActionType)
-> (Ptr ActionGotoRemote -> IO ActionType) -> IO ActionType
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> 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' actionGotoRemote [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionGotoRemoteType :: MonadIO m => ActionGotoRemote -> Poppler.Enums.ActionType -> m ()
setActionGotoRemoteType :: ActionGotoRemote -> ActionType -> m ()
setActionGotoRemoteType s :: ActionGotoRemote
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
$ ActionGotoRemote -> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO ()) -> IO ())
-> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
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 ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CUInt
val' :: CUInt)

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

actionGotoRemote_type :: AttrLabelProxy "type"
actionGotoRemote_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' actionGotoRemote #title
-- @
getActionGotoRemoteTitle :: MonadIO m => ActionGotoRemote -> m (Maybe T.Text)
getActionGotoRemoteTitle :: ActionGotoRemote -> m (Maybe Text)
getActionGotoRemoteTitle s :: ActionGotoRemote
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
$ ActionGotoRemote
-> (Ptr ActionGotoRemote -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionGotoRemote -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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
$ \val' :: 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' actionGotoRemote [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionGotoRemoteTitle :: MonadIO m => ActionGotoRemote -> CString -> m ()
setActionGotoRemoteTitle :: ActionGotoRemote -> CString -> m ()
setActionGotoRemoteTitle s :: ActionGotoRemote
s val :: 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
$ ActionGotoRemote -> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO ()) -> IO ())
-> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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
-- @
clearActionGotoRemoteTitle :: MonadIO m => ActionGotoRemote -> m ()
clearActionGotoRemoteTitle :: ActionGotoRemote -> m ()
clearActionGotoRemoteTitle s :: ActionGotoRemote
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionGotoRemote -> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO ()) -> IO ())
-> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ActionGotoRemoteTitleFieldInfo
instance AttrInfo ActionGotoRemoteTitleFieldInfo where
    type AttrBaseTypeConstraint ActionGotoRemoteTitleFieldInfo = (~) ActionGotoRemote
    type AttrAllowedOps ActionGotoRemoteTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionGotoRemoteTitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionGotoRemoteTitleFieldInfo = (~)CString
    type AttrTransferType ActionGotoRemoteTitleFieldInfo = CString
    type AttrGetType ActionGotoRemoteTitleFieldInfo = Maybe T.Text
    type AttrLabel ActionGotoRemoteTitleFieldInfo = "title"
    type AttrOrigin ActionGotoRemoteTitleFieldInfo = ActionGotoRemote
    attrGet = getActionGotoRemoteTitle
    attrSet = setActionGotoRemoteTitle
    attrConstruct = undefined
    attrClear = clearActionGotoRemoteTitle
    attrTransfer _ v = do
        return v

actionGotoRemote_title :: AttrLabelProxy "title"
actionGotoRemote_title = AttrLabelProxy

#endif


-- | Get the value of the “@file_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionGotoRemote #fileName
-- @
getActionGotoRemoteFileName :: MonadIO m => ActionGotoRemote -> m (Maybe T.Text)
getActionGotoRemoteFileName :: ActionGotoRemote -> m (Maybe Text)
getActionGotoRemoteFileName s :: ActionGotoRemote
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
$ ActionGotoRemote
-> (Ptr ActionGotoRemote -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionGotoRemote -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) :: 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
$ \val' :: 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 “@file_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionGotoRemote [ #fileName 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionGotoRemoteFileName :: MonadIO m => ActionGotoRemote -> CString -> m ()
setActionGotoRemoteFileName :: ActionGotoRemote -> CString -> m ()
setActionGotoRemoteFileName s :: ActionGotoRemote
s val :: 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
$ ActionGotoRemote -> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO ()) -> IO ())
-> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (CString
val :: CString)

-- | Set the value of the “@file_name@” 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' #fileName
-- @
clearActionGotoRemoteFileName :: MonadIO m => ActionGotoRemote -> m ()
clearActionGotoRemoteFileName :: ActionGotoRemote -> m ()
clearActionGotoRemoteFileName s :: ActionGotoRemote
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionGotoRemote -> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO ()) -> IO ())
-> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ActionGotoRemoteFileNameFieldInfo
instance AttrInfo ActionGotoRemoteFileNameFieldInfo where
    type AttrBaseTypeConstraint ActionGotoRemoteFileNameFieldInfo = (~) ActionGotoRemote
    type AttrAllowedOps ActionGotoRemoteFileNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionGotoRemoteFileNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionGotoRemoteFileNameFieldInfo = (~)CString
    type AttrTransferType ActionGotoRemoteFileNameFieldInfo = CString
    type AttrGetType ActionGotoRemoteFileNameFieldInfo = Maybe T.Text
    type AttrLabel ActionGotoRemoteFileNameFieldInfo = "file_name"
    type AttrOrigin ActionGotoRemoteFileNameFieldInfo = ActionGotoRemote
    attrGet = getActionGotoRemoteFileName
    attrSet = setActionGotoRemoteFileName
    attrConstruct = undefined
    attrClear = clearActionGotoRemoteFileName
    attrTransfer _ v = do
        return v

actionGotoRemote_fileName :: AttrLabelProxy "fileName"
actionGotoRemote_fileName = 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' actionGotoRemote #dest
-- @
getActionGotoRemoteDest :: MonadIO m => ActionGotoRemote -> m (Maybe Poppler.Dest.Dest)
getActionGotoRemoteDest :: ActionGotoRemote -> m (Maybe Dest)
getActionGotoRemoteDest s :: ActionGotoRemote
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
$ ActionGotoRemote
-> (Ptr ActionGotoRemote -> IO (Maybe Dest)) -> IO (Maybe Dest)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO (Maybe Dest)) -> IO (Maybe Dest))
-> (Ptr ActionGotoRemote -> IO (Maybe Dest)) -> IO (Maybe Dest)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    Ptr Dest
val <- Ptr (Ptr Dest) -> IO (Ptr Dest)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr (Ptr Dest)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) :: 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
$ \val' :: Ptr Dest
val' -> do
        Dest
val'' <- ((ManagedPtr Dest -> Dest) -> Ptr Dest -> IO Dest
forall a.
(HasCallStack, BoxedObject 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' actionGotoRemote [ #dest 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionGotoRemoteDest :: MonadIO m => ActionGotoRemote -> Ptr Poppler.Dest.Dest -> m ()
setActionGotoRemoteDest :: ActionGotoRemote -> Ptr Dest -> m ()
setActionGotoRemoteDest s :: ActionGotoRemote
s val :: 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
$ ActionGotoRemote -> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO ()) -> IO ())
-> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    Ptr (Ptr Dest) -> Ptr Dest -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr (Ptr Dest)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) (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
-- @
clearActionGotoRemoteDest :: MonadIO m => ActionGotoRemote -> m ()
clearActionGotoRemoteDest :: ActionGotoRemote -> m ()
clearActionGotoRemoteDest s :: ActionGotoRemote
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionGotoRemote -> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionGotoRemote
s ((Ptr ActionGotoRemote -> IO ()) -> IO ())
-> (Ptr ActionGotoRemote -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionGotoRemote
ptr -> do
    Ptr (Ptr Dest) -> Ptr Dest -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionGotoRemote
ptr Ptr ActionGotoRemote -> Int -> Ptr (Ptr Dest)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) (Ptr Dest
forall a. Ptr a
FP.nullPtr :: Ptr Poppler.Dest.Dest)

#if defined(ENABLE_OVERLOADING)
data ActionGotoRemoteDestFieldInfo
instance AttrInfo ActionGotoRemoteDestFieldInfo where
    type AttrBaseTypeConstraint ActionGotoRemoteDestFieldInfo = (~) ActionGotoRemote
    type AttrAllowedOps ActionGotoRemoteDestFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionGotoRemoteDestFieldInfo = (~) (Ptr Poppler.Dest.Dest)
    type AttrTransferTypeConstraint ActionGotoRemoteDestFieldInfo = (~)(Ptr Poppler.Dest.Dest)
    type AttrTransferType ActionGotoRemoteDestFieldInfo = (Ptr Poppler.Dest.Dest)
    type AttrGetType ActionGotoRemoteDestFieldInfo = Maybe Poppler.Dest.Dest
    type AttrLabel ActionGotoRemoteDestFieldInfo = "dest"
    type AttrOrigin ActionGotoRemoteDestFieldInfo = ActionGotoRemote
    attrGet = getActionGotoRemoteDest
    attrSet = setActionGotoRemoteDest
    attrConstruct = undefined
    attrClear = clearActionGotoRemoteDest
    attrTransfer _ v = do
        return v

actionGotoRemote_dest :: AttrLabelProxy "dest"
actionGotoRemote_dest = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionGotoRemote
type instance O.AttributeList ActionGotoRemote = ActionGotoRemoteAttributeList
type ActionGotoRemoteAttributeList = ('[ '("type", ActionGotoRemoteTypeFieldInfo), '("title", ActionGotoRemoteTitleFieldInfo), '("fileName", ActionGotoRemoteFileNameFieldInfo), '("dest", ActionGotoRemoteDestFieldInfo)] :: [(Symbol, *)])
#endif

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

instance (info ~ ResolveActionGotoRemoteMethod t ActionGotoRemote, O.MethodInfo info ActionGotoRemote p) => OL.IsLabel t (ActionGotoRemote -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif