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

/No description available in the introspection data./
-}

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

module GI.Poppler.Structs.ActionGotoRemote
    (

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


 -- * Properties
-- ** dest #attr:dest#
{- | /No description available in the introspection data./
-}
#if ENABLE_OVERLOADING
    actionGotoRemote_dest                   ,
#endif
    clearActionGotoRemoteDest               ,
    getActionGotoRemoteDest                 ,
    setActionGotoRemoteDest                 ,


-- ** fileName #attr:fileName#
{- | /No description available in the introspection data./
-}
#if ENABLE_OVERLOADING
    actionGotoRemote_fileName               ,
#endif
    clearActionGotoRemoteFileName           ,
    getActionGotoRemoteFileName             ,
    setActionGotoRemoteFileName             ,


-- ** title #attr:title#
{- | /No description available in the introspection data./
-}
#if ENABLE_OVERLOADING
    actionGotoRemote_title                  ,
#endif
    clearActionGotoRemoteTitle              ,
    getActionGotoRemoteTitle                ,
    setActionGotoRemoteTitle                ,


-- ** type #attr:type#
{- | /No description available in the introspection data./
-}
#if 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.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)
instance WrappedPtr ActionGotoRemote where
    wrappedPtrCalloc = callocBytes 32
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 32 >=> wrapPtr ActionGotoRemote)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `ActionGotoRemote` struct initialized to zero.
newZeroActionGotoRemote :: MonadIO m => m ActionGotoRemote
newZeroActionGotoRemote = liftIO $ wrappedPtrCalloc >>= wrapPtr ActionGotoRemote

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


-- | A convenience alias for `Nothing` :: `Maybe` `ActionGotoRemote`.
noActionGotoRemote :: Maybe ActionGotoRemote
noActionGotoRemote = 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 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return 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 s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

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

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 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return 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 s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (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 s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: CString)

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

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 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return 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 s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (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 s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: CString)

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

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 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO (Ptr Poppler.Dest.Dest)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newBoxed Poppler.Dest.Dest) val'
        return val''
    return 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 s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (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 s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (FP.nullPtr :: Ptr Poppler.Dest.Dest)

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

actionGotoRemote_dest :: AttrLabelProxy "dest"
actionGotoRemote_dest = AttrLabelProxy

#endif



#if 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 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 (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif

#endif