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

-- * Exported types
    AnnotMovie(..)                          ,
    IsAnnotMovie                            ,
    toAnnotMovie                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAnnotMovieMethod                 ,
#endif


-- ** getMovie #method:getMovie#

#if defined(ENABLE_OVERLOADING)
    AnnotMovieGetMovieMethodInfo            ,
#endif
    annotMovieGetMovie                      ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    AnnotMovieGetTitleMethodInfo            ,
#endif
    annotMovieGetTitle                      ,




    ) 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.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 qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Poppler.Objects.Annot as Poppler.Annot
import {-# SOURCE #-} qualified GI.Poppler.Objects.Movie as Poppler.Movie

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

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

foreign import ccall "poppler_annot_movie_get_type"
    c_poppler_annot_movie_get_type :: IO B.Types.GType

instance B.Types.TypedObject AnnotMovie where
    glibType :: IO GType
glibType = IO GType
c_poppler_annot_movie_get_type

instance B.Types.GObject AnnotMovie

-- | Convert 'AnnotMovie' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue AnnotMovie where
    toGValue :: AnnotMovie -> IO GValue
toGValue AnnotMovie
o = do
        GType
gtype <- IO GType
c_poppler_annot_movie_get_type
        AnnotMovie -> (Ptr AnnotMovie -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AnnotMovie
o (GType
-> (GValue -> Ptr AnnotMovie -> IO ())
-> Ptr AnnotMovie
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr AnnotMovie -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO AnnotMovie
fromGValue GValue
gv = do
        Ptr AnnotMovie
ptr <- GValue -> IO (Ptr AnnotMovie)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr AnnotMovie)
        (ManagedPtr AnnotMovie -> AnnotMovie)
-> Ptr AnnotMovie -> IO AnnotMovie
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AnnotMovie -> AnnotMovie
AnnotMovie Ptr AnnotMovie
ptr
        
    

-- | Type class for types which can be safely cast to `AnnotMovie`, for instance with `toAnnotMovie`.
class (SP.GObject o, O.IsDescendantOf AnnotMovie o) => IsAnnotMovie o
instance (SP.GObject o, O.IsDescendantOf AnnotMovie o) => IsAnnotMovie o

instance O.HasParentTypes AnnotMovie
type instance O.ParentTypes AnnotMovie = '[Poppler.Annot.Annot, GObject.Object.Object]

-- | Cast to `AnnotMovie`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAnnotMovie :: (MonadIO m, IsAnnotMovie o) => o -> m AnnotMovie
toAnnotMovie :: o -> m AnnotMovie
toAnnotMovie = IO AnnotMovie -> m AnnotMovie
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnnotMovie -> m AnnotMovie)
-> (o -> IO AnnotMovie) -> o -> m AnnotMovie
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AnnotMovie -> AnnotMovie) -> o -> IO AnnotMovie
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr AnnotMovie -> AnnotMovie
AnnotMovie

#if defined(ENABLE_OVERLOADING)
type family ResolveAnnotMovieMethod (t :: Symbol) (o :: *) :: * where
    ResolveAnnotMovieMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnnotMovieMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnnotMovieMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnnotMovieMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnnotMovieMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnnotMovieMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnnotMovieMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnnotMovieMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnnotMovieMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnnotMovieMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnnotMovieMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnnotMovieMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnnotMovieMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnnotMovieMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnnotMovieMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnnotMovieMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnnotMovieMethod "getAnnotType" o = Poppler.Annot.AnnotGetAnnotTypeMethodInfo
    ResolveAnnotMovieMethod "getColor" o = Poppler.Annot.AnnotGetColorMethodInfo
    ResolveAnnotMovieMethod "getContents" o = Poppler.Annot.AnnotGetContentsMethodInfo
    ResolveAnnotMovieMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnnotMovieMethod "getFlags" o = Poppler.Annot.AnnotGetFlagsMethodInfo
    ResolveAnnotMovieMethod "getModified" o = Poppler.Annot.AnnotGetModifiedMethodInfo
    ResolveAnnotMovieMethod "getMovie" o = AnnotMovieGetMovieMethodInfo
    ResolveAnnotMovieMethod "getName" o = Poppler.Annot.AnnotGetNameMethodInfo
    ResolveAnnotMovieMethod "getPageIndex" o = Poppler.Annot.AnnotGetPageIndexMethodInfo
    ResolveAnnotMovieMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnnotMovieMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnnotMovieMethod "getRectangle" o = Poppler.Annot.AnnotGetRectangleMethodInfo
    ResolveAnnotMovieMethod "getTitle" o = AnnotMovieGetTitleMethodInfo
    ResolveAnnotMovieMethod "setColor" o = Poppler.Annot.AnnotSetColorMethodInfo
    ResolveAnnotMovieMethod "setContents" o = Poppler.Annot.AnnotSetContentsMethodInfo
    ResolveAnnotMovieMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnnotMovieMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnnotMovieMethod "setFlags" o = Poppler.Annot.AnnotSetFlagsMethodInfo
    ResolveAnnotMovieMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnnotMovieMethod "setRectangle" o = Poppler.Annot.AnnotSetRectangleMethodInfo
    ResolveAnnotMovieMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AnnotMovie
type instance O.AttributeList AnnotMovie = AnnotMovieAttributeList
type AnnotMovieAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AnnotMovie = AnnotMovieSignalList
type AnnotMovieSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method AnnotMovie::get_movie
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMovie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMovie"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Poppler" , name = "Movie" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_movie_get_movie" poppler_annot_movie_get_movie :: 
    Ptr AnnotMovie ->                       -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMovie"})
    IO (Ptr Poppler.Movie.Movie)

-- | Retrieves the movie object (PopplerMovie) stored in the /@popplerAnnot@/.
-- 
-- /Since: 0.14/
annotMovieGetMovie ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMovie a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMovie.AnnotMovie'
    -> m Poppler.Movie.Movie
    -- ^ __Returns:__ the movie object stored in the /@popplerAnnot@/. The returned
    --               object is owned by t'GI.Poppler.Objects.AnnotMovie.AnnotMovie' and should not be freed
annotMovieGetMovie :: a -> m Movie
annotMovieGetMovie a
popplerAnnot = IO Movie -> m Movie
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Movie -> m Movie) -> IO Movie -> m Movie
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMovie
popplerAnnot' <- a -> IO (Ptr AnnotMovie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Movie
result <- Ptr AnnotMovie -> IO (Ptr Movie)
poppler_annot_movie_get_movie Ptr AnnotMovie
popplerAnnot'
    Text -> Ptr Movie -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotMovieGetMovie" Ptr Movie
result
    Movie
result' <- ((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
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Movie -> IO Movie
forall (m :: * -> *) a. Monad m => a -> m a
return Movie
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMovieGetMovieMethodInfo
instance (signature ~ (m Poppler.Movie.Movie), MonadIO m, IsAnnotMovie a) => O.MethodInfo AnnotMovieGetMovieMethodInfo a signature where
    overloadedMethod = annotMovieGetMovie

#endif

-- method AnnotMovie::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMovie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMovie"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_movie_get_title" poppler_annot_movie_get_title :: 
    Ptr AnnotMovie ->                       -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMovie"})
    IO CString

-- | Retrieves the movie title of /@popplerAnnot@/.
-- 
-- /Since: 0.14/
annotMovieGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMovie a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMovie.AnnotMovie'
    -> m T.Text
    -- ^ __Returns:__ the title text of /@popplerAnnot@/.
annotMovieGetTitle :: a -> m Text
annotMovieGetTitle a
popplerAnnot = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMovie
popplerAnnot' <- a -> IO (Ptr AnnotMovie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CString
result <- Ptr AnnotMovie -> IO CString
poppler_annot_movie_get_title Ptr AnnotMovie
popplerAnnot'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotMovieGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMovieGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAnnotMovie a) => O.MethodInfo AnnotMovieGetTitleMethodInfo a signature where
    overloadedMethod = annotMovieGetTitle

#endif