{-# 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.ActionRendition
    ( 

-- * Exported types
    ActionRendition(..)                     ,
    newZeroActionRendition                  ,
    noActionRendition                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveActionRenditionMethod            ,
#endif




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

#if defined(ENABLE_OVERLOADING)
    actionRendition_media                   ,
#endif
    clearActionRenditionMedia               ,
    getActionRenditionMedia                 ,
    setActionRenditionMedia                 ,


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

#if defined(ENABLE_OVERLOADING)
    actionRendition_op                      ,
#endif
    getActionRenditionOp                    ,
    setActionRenditionOp                    ,


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

#if defined(ENABLE_OVERLOADING)
    actionRendition_title                   ,
#endif
    clearActionRenditionTitle               ,
    getActionRenditionTitle                 ,
    setActionRenditionTitle                 ,


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

#if defined(ENABLE_OVERLOADING)
    actionRendition_type                    ,
#endif
    getActionRenditionType                  ,
    setActionRenditionType                  ,




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

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

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

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


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

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

actionRendition_type :: AttrLabelProxy "type"
actionRendition_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' actionRendition #title
-- @
getActionRenditionTitle :: MonadIO m => ActionRendition -> m (Maybe T.Text)
getActionRenditionTitle :: ActionRendition -> m (Maybe Text)
getActionRenditionTitle s :: ActionRendition
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
$ ActionRendition
-> (Ptr ActionRendition -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionRendition
s ((Ptr ActionRendition -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionRendition -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionRendition
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionRendition
ptr Ptr ActionRendition -> 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' actionRendition [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionRenditionTitle :: MonadIO m => ActionRendition -> CString -> m ()
setActionRenditionTitle :: ActionRendition -> CString -> m ()
setActionRenditionTitle s :: ActionRendition
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
$ ActionRendition -> (Ptr ActionRendition -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionRendition
s ((Ptr ActionRendition -> IO ()) -> IO ())
-> (Ptr ActionRendition -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionRendition
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionRendition
ptr Ptr ActionRendition -> 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
-- @
clearActionRenditionTitle :: MonadIO m => ActionRendition -> m ()
clearActionRenditionTitle :: ActionRendition -> m ()
clearActionRenditionTitle s :: ActionRendition
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionRendition -> (Ptr ActionRendition -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionRendition
s ((Ptr ActionRendition -> IO ()) -> IO ())
-> (Ptr ActionRendition -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionRendition
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionRendition
ptr Ptr ActionRendition -> 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 ActionRenditionTitleFieldInfo
instance AttrInfo ActionRenditionTitleFieldInfo where
    type AttrBaseTypeConstraint ActionRenditionTitleFieldInfo = (~) ActionRendition
    type AttrAllowedOps ActionRenditionTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionRenditionTitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionRenditionTitleFieldInfo = (~)CString
    type AttrTransferType ActionRenditionTitleFieldInfo = CString
    type AttrGetType ActionRenditionTitleFieldInfo = Maybe T.Text
    type AttrLabel ActionRenditionTitleFieldInfo = "title"
    type AttrOrigin ActionRenditionTitleFieldInfo = ActionRendition
    attrGet = getActionRenditionTitle
    attrSet = setActionRenditionTitle
    attrConstruct = undefined
    attrClear = clearActionRenditionTitle
    attrTransfer _ v = do
        return v

actionRendition_title :: AttrLabelProxy "title"
actionRendition_title = AttrLabelProxy

#endif


-- | Get the value of the “@op@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionRendition #op
-- @
getActionRenditionOp :: MonadIO m => ActionRendition -> m Int32
getActionRenditionOp :: ActionRendition -> m Int32
getActionRenditionOp s :: ActionRendition
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ ActionRendition -> (Ptr ActionRendition -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionRendition
s ((Ptr ActionRendition -> IO Int32) -> IO Int32)
-> (Ptr ActionRendition -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionRendition
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionRendition
ptr Ptr ActionRendition -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data ActionRenditionOpFieldInfo
instance AttrInfo ActionRenditionOpFieldInfo where
    type AttrBaseTypeConstraint ActionRenditionOpFieldInfo = (~) ActionRendition
    type AttrAllowedOps ActionRenditionOpFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionRenditionOpFieldInfo = (~) Int32
    type AttrTransferTypeConstraint ActionRenditionOpFieldInfo = (~)Int32
    type AttrTransferType ActionRenditionOpFieldInfo = Int32
    type AttrGetType ActionRenditionOpFieldInfo = Int32
    type AttrLabel ActionRenditionOpFieldInfo = "op"
    type AttrOrigin ActionRenditionOpFieldInfo = ActionRendition
    attrGet = getActionRenditionOp
    attrSet = setActionRenditionOp
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

actionRendition_op :: AttrLabelProxy "op"
actionRendition_op = AttrLabelProxy

#endif


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

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

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

#if defined(ENABLE_OVERLOADING)
data ActionRenditionMediaFieldInfo
instance AttrInfo ActionRenditionMediaFieldInfo where
    type AttrBaseTypeConstraint ActionRenditionMediaFieldInfo = (~) ActionRendition
    type AttrAllowedOps ActionRenditionMediaFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionRenditionMediaFieldInfo = (~) (Ptr Poppler.Media.Media)
    type AttrTransferTypeConstraint ActionRenditionMediaFieldInfo = (~)(Ptr Poppler.Media.Media)
    type AttrTransferType ActionRenditionMediaFieldInfo = (Ptr Poppler.Media.Media)
    type AttrGetType ActionRenditionMediaFieldInfo = Maybe Poppler.Media.Media
    type AttrLabel ActionRenditionMediaFieldInfo = "media"
    type AttrOrigin ActionRenditionMediaFieldInfo = ActionRendition
    attrGet = getActionRenditionMedia
    attrSet = setActionRenditionMedia
    attrConstruct = undefined
    attrClear = clearActionRenditionMedia
    attrTransfer _ v = do
        return v

actionRendition_media :: AttrLabelProxy "media"
actionRendition_media = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionRendition
type instance O.AttributeList ActionRendition = ActionRenditionAttributeList
type ActionRenditionAttributeList = ('[ '("type", ActionRenditionTypeFieldInfo), '("title", ActionRenditionTitleFieldInfo), '("op", ActionRenditionOpFieldInfo), '("media", ActionRenditionMediaFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif