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

-- * Exported types
    ActionMovie(..)                         ,
    newZeroActionMovie                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveActionMovieMethod                ,
#endif




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

#if defined(ENABLE_OVERLOADING)
    actionMovie_movie                       ,
#endif
    clearActionMovieMovie                   ,
    getActionMovieMovie                     ,
    setActionMovieMovie                     ,


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

#if defined(ENABLE_OVERLOADING)
    actionMovie_operation                   ,
#endif
    getActionMovieOperation                 ,
    setActionMovieOperation                 ,


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

#if defined(ENABLE_OVERLOADING)
    actionMovie_title                       ,
#endif
    clearActionMovieTitle                   ,
    getActionMovieTitle                     ,
    setActionMovieTitle                     ,


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

#if defined(ENABLE_OVERLOADING)
    actionMovie_type                        ,
#endif
    getActionMovieType                      ,
    setActionMovieType                      ,




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

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

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

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


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

instance tag ~ 'AttrSet => Constructible ActionMovie tag where
    new :: (ManagedPtr ActionMovie -> ActionMovie)
-> [AttrOp ActionMovie tag] -> m ActionMovie
new ManagedPtr ActionMovie -> ActionMovie
_ [AttrOp ActionMovie tag]
attrs = do
        ActionMovie
o <- m ActionMovie
forall (m :: * -> *). MonadIO m => m ActionMovie
newZeroActionMovie
        ActionMovie -> [AttrOp ActionMovie 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ActionMovie
o [AttrOp ActionMovie tag]
[AttrOp ActionMovie 'AttrSet]
attrs
        ActionMovie -> m ActionMovie
forall (m :: * -> *) a. Monad m => a -> m a
return ActionMovie
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' actionMovie #type
-- @
getActionMovieType :: MonadIO m => ActionMovie -> m Poppler.Enums.ActionType
getActionMovieType :: ActionMovie -> m ActionType
getActionMovieType ActionMovie
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
$ ActionMovie -> (Ptr ActionMovie -> IO ActionType) -> IO ActionType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionMovie
s ((Ptr ActionMovie -> IO ActionType) -> IO ActionType)
-> (Ptr ActionMovie -> IO ActionType) -> IO ActionType
forall a b. (a -> b) -> a -> b
$ \Ptr ActionMovie
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionMovie
ptr Ptr ActionMovie -> 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' actionMovie [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionMovieType :: MonadIO m => ActionMovie -> Poppler.Enums.ActionType -> m ()
setActionMovieType :: ActionMovie -> ActionType -> m ()
setActionMovieType ActionMovie
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
$ ActionMovie -> (Ptr ActionMovie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionMovie
s ((Ptr ActionMovie -> IO ()) -> IO ())
-> (Ptr ActionMovie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionMovie
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 ActionMovie
ptr Ptr ActionMovie -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

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

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

actionMovie_title :: AttrLabelProxy "title"
actionMovie_title = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data ActionMovieOperationFieldInfo
instance AttrInfo ActionMovieOperationFieldInfo where
    type AttrBaseTypeConstraint ActionMovieOperationFieldInfo = (~) ActionMovie
    type AttrAllowedOps ActionMovieOperationFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionMovieOperationFieldInfo = (~) Poppler.Enums.ActionMovieOperation
    type AttrTransferTypeConstraint ActionMovieOperationFieldInfo = (~)Poppler.Enums.ActionMovieOperation
    type AttrTransferType ActionMovieOperationFieldInfo = Poppler.Enums.ActionMovieOperation
    type AttrGetType ActionMovieOperationFieldInfo = Poppler.Enums.ActionMovieOperation
    type AttrLabel ActionMovieOperationFieldInfo = "operation"
    type AttrOrigin ActionMovieOperationFieldInfo = ActionMovie
    attrGet = getActionMovieOperation
    attrSet = setActionMovieOperation
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

actionMovie_operation :: AttrLabelProxy "operation"
actionMovie_operation = 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' actionMovie #movie
-- @
getActionMovieMovie :: MonadIO m => ActionMovie -> m (Maybe Poppler.Movie.Movie)
getActionMovieMovie :: ActionMovie -> m (Maybe Movie)
getActionMovieMovie ActionMovie
s = IO (Maybe Movie) -> m (Maybe Movie)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Movie) -> m (Maybe Movie))
-> IO (Maybe Movie) -> m (Maybe Movie)
forall a b. (a -> b) -> a -> b
$ ActionMovie
-> (Ptr ActionMovie -> IO (Maybe Movie)) -> IO (Maybe Movie)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionMovie
s ((Ptr ActionMovie -> IO (Maybe Movie)) -> IO (Maybe Movie))
-> (Ptr ActionMovie -> IO (Maybe Movie)) -> IO (Maybe Movie)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionMovie
ptr -> do
    Ptr Movie
val <- Ptr (Ptr Movie) -> IO (Ptr Movie)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionMovie
ptr Ptr ActionMovie -> Int -> Ptr (Ptr Movie)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO (Ptr Poppler.Movie.Movie)
    Maybe Movie
result <- Ptr Movie -> (Ptr Movie -> IO Movie) -> IO (Maybe Movie)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Movie
val ((Ptr Movie -> IO Movie) -> IO (Maybe Movie))
-> (Ptr Movie -> IO Movie) -> IO (Maybe Movie)
forall a b. (a -> b) -> a -> b
$ \Ptr Movie
val' -> do
        Movie
val'' <- ((ManagedPtr Movie -> Movie) -> Ptr Movie -> IO Movie
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Movie -> Movie
Poppler.Movie.Movie) Ptr Movie
val'
        Movie -> IO Movie
forall (m :: * -> *) a. Monad m => a -> m a
return Movie
val''
    Maybe Movie -> IO (Maybe Movie)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Movie
result

-- | Set 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.set' actionMovie [ #movie 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionMovieMovie :: MonadIO m => ActionMovie -> Ptr Poppler.Movie.Movie -> m ()
setActionMovieMovie :: ActionMovie -> Ptr Movie -> m ()
setActionMovieMovie ActionMovie
s Ptr Movie
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionMovie -> (Ptr ActionMovie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionMovie
s ((Ptr ActionMovie -> IO ()) -> IO ())
-> (Ptr ActionMovie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionMovie
ptr -> do
    Ptr (Ptr Movie) -> Ptr Movie -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionMovie
ptr Ptr ActionMovie -> Int -> Ptr (Ptr Movie)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Ptr Movie
val :: Ptr Poppler.Movie.Movie)

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

#if defined(ENABLE_OVERLOADING)
data ActionMovieMovieFieldInfo
instance AttrInfo ActionMovieMovieFieldInfo where
    type AttrBaseTypeConstraint ActionMovieMovieFieldInfo = (~) ActionMovie
    type AttrAllowedOps ActionMovieMovieFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionMovieMovieFieldInfo = (~) (Ptr Poppler.Movie.Movie)
    type AttrTransferTypeConstraint ActionMovieMovieFieldInfo = (~)(Ptr Poppler.Movie.Movie)
    type AttrTransferType ActionMovieMovieFieldInfo = (Ptr Poppler.Movie.Movie)
    type AttrGetType ActionMovieMovieFieldInfo = Maybe Poppler.Movie.Movie
    type AttrLabel ActionMovieMovieFieldInfo = "movie"
    type AttrOrigin ActionMovieMovieFieldInfo = ActionMovie
    attrGet = getActionMovieMovie
    attrSet = setActionMovieMovie
    attrConstruct = undefined
    attrClear = clearActionMovieMovie
    attrTransfer _ v = do
        return v

actionMovie_movie :: AttrLabelProxy "movie"
actionMovie_movie = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionMovie
type instance O.AttributeList ActionMovie = ActionMovieAttributeList
type ActionMovieAttributeList = ('[ '("type", ActionMovieTypeFieldInfo), '("title", ActionMovieTitleFieldInfo), '("operation", ActionMovieOperationFieldInfo), '("movie", ActionMovieMovieFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif