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

-- * Exported types
    Media(..)                               ,
    IsMedia                                 ,
    toMedia                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isEmbedded]("GI.Poppler.Objects.Media#g:method:isEmbedded"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [save]("GI.Poppler.Objects.Media#g:method:save"), [saveToCallback]("GI.Poppler.Objects.Media#g:method:saveToCallback"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFilename]("GI.Poppler.Objects.Media#g:method:getFilename"), [getMimeType]("GI.Poppler.Objects.Media#g:method:getMimeType"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveMediaMethod                      ,
#endif

-- ** getFilename #method:getFilename#

#if defined(ENABLE_OVERLOADING)
    MediaGetFilenameMethodInfo              ,
#endif
    mediaGetFilename                        ,


-- ** getMimeType #method:getMimeType#

#if defined(ENABLE_OVERLOADING)
    MediaGetMimeTypeMethodInfo              ,
#endif
    mediaGetMimeType                        ,


-- ** isEmbedded #method:isEmbedded#

#if defined(ENABLE_OVERLOADING)
    MediaIsEmbeddedMethodInfo               ,
#endif
    mediaIsEmbedded                         ,


-- ** save #method:save#

#if defined(ENABLE_OVERLOADING)
    MediaSaveMethodInfo                     ,
#endif
    mediaSave                               ,


-- ** saveToCallback #method:saveToCallback#

#if defined(ENABLE_OVERLOADING)
    MediaSaveToCallbackMethodInfo           ,
#endif
    mediaSaveToCallback                     ,




    ) 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 qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Poppler.Callbacks as Poppler.Callbacks

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

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

foreign import ccall "poppler_media_get_type"
    c_poppler_media_get_type :: IO B.Types.GType

instance B.Types.TypedObject Media where
    glibType :: IO GType
glibType = IO GType
c_poppler_media_get_type

instance B.Types.GObject Media

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

instance O.HasParentTypes Media
type instance O.ParentTypes Media = '[GObject.Object.Object]

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

-- | Convert 'Media' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Media) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_poppler_media_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Media -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Media
P.Nothing = Ptr GValue -> Ptr Media -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Media
forall a. Ptr a
FP.nullPtr :: FP.Ptr Media)
    gvalueSet_ Ptr GValue
gv (P.Just Media
obj) = Media -> (Ptr Media -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Media
obj (Ptr GValue -> Ptr Media -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Media)
gvalueGet_ Ptr GValue
gv = do
        Ptr Media
ptr <- Ptr GValue -> IO (Ptr Media)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Media)
        if Ptr Media
ptr Ptr Media -> Ptr Media -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Media
forall a. Ptr a
FP.nullPtr
        then Media -> Maybe Media
forall a. a -> Maybe a
P.Just (Media -> Maybe Media) -> IO Media -> IO (Maybe Media)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Media -> Media) -> Ptr Media -> IO Media
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Media -> Media
Media Ptr Media
ptr
        else Maybe Media -> IO (Maybe Media)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Media
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveMediaMethod (t :: Symbol) (o :: *) :: * where
    ResolveMediaMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMediaMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMediaMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMediaMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMediaMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMediaMethod "isEmbedded" o = MediaIsEmbeddedMethodInfo
    ResolveMediaMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMediaMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMediaMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMediaMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMediaMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMediaMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMediaMethod "save" o = MediaSaveMethodInfo
    ResolveMediaMethod "saveToCallback" o = MediaSaveToCallbackMethodInfo
    ResolveMediaMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMediaMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMediaMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMediaMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMediaMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMediaMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMediaMethod "getFilename" o = MediaGetFilenameMethodInfo
    ResolveMediaMethod "getMimeType" o = MediaGetMimeTypeMethodInfo
    ResolveMediaMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMediaMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMediaMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMediaMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMediaMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMediaMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveMediaMethod t Media, O.OverloadedMethod info Media p, R.HasField t Media p) => R.HasField t Media p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveMediaMethod t Media, O.OverloadedMethodInfo info Media) => OL.IsLabel t (O.MethodProxy info Media) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Media::get_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_media"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Media" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMedia" , 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_media_get_filename" poppler_media_get_filename :: 
    Ptr Media ->                            -- poppler_media : TInterface (Name {namespace = "Poppler", name = "Media"})
    IO CString

-- | Returns the media clip filename, in case of non-embedded media. filename might be
-- a local relative or absolute path or a URI
-- 
-- /Since: 0.14/
mediaGetFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsMedia a) =>
    a
    -- ^ /@popplerMedia@/: a t'GI.Poppler.Objects.Media.Media'
    -> m T.Text
    -- ^ __Returns:__ a filename, return value is owned by t'GI.Poppler.Objects.Media.Media' and should not be freed
mediaGetFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMedia a) =>
a -> m Text
mediaGetFilename a
popplerMedia = 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 Media
popplerMedia' <- a -> IO (Ptr Media)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMedia
    CString
result <- Ptr Media -> IO CString
poppler_media_get_filename Ptr Media
popplerMedia'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mediaGetFilename" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMedia
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MediaGetFilenameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMedia a) => O.OverloadedMethod MediaGetFilenameMethodInfo a signature where
    overloadedMethod = mediaGetFilename

instance O.OverloadedMethodInfo MediaGetFilenameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Media.mediaGetFilename",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Media.html#v:mediaGetFilename"
        }


#endif

-- method Media::get_mime_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_media"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Media" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMedia" , 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_media_get_mime_type" poppler_media_get_mime_type :: 
    Ptr Media ->                            -- poppler_media : TInterface (Name {namespace = "Poppler", name = "Media"})
    IO CString

-- | Returns the media clip mime-type
-- 
-- /Since: 0.14/
mediaGetMimeType ::
    (B.CallStack.HasCallStack, MonadIO m, IsMedia a) =>
    a
    -- ^ /@popplerMedia@/: a t'GI.Poppler.Objects.Media.Media'
    -> m T.Text
    -- ^ __Returns:__ the mime-type, return value is owned by t'GI.Poppler.Objects.Media.Media' and should not be freed
mediaGetMimeType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMedia a) =>
a -> m Text
mediaGetMimeType a
popplerMedia = 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 Media
popplerMedia' <- a -> IO (Ptr Media)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMedia
    CString
result <- Ptr Media -> IO CString
poppler_media_get_mime_type Ptr Media
popplerMedia'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mediaGetMimeType" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMedia
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MediaGetMimeTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMedia a) => O.OverloadedMethod MediaGetMimeTypeMethodInfo a signature where
    overloadedMethod = mediaGetMimeType

instance O.OverloadedMethodInfo MediaGetMimeTypeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Media.mediaGetMimeType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Media.html#v:mediaGetMimeType"
        }


#endif

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

foreign import ccall "poppler_media_is_embedded" poppler_media_is_embedded :: 
    Ptr Media ->                            -- poppler_media : TInterface (Name {namespace = "Poppler", name = "Media"})
    IO CInt

-- | Whether the media clip is embedded in the PDF. If the result is 'P.True', the embedded stream
-- can be saved with 'GI.Poppler.Objects.Media.mediaSave' or 'GI.Poppler.Objects.Media.mediaSaveToCallback' function.
-- If the result is 'P.False', the media clip filename can be retrieved with
-- 'GI.Poppler.Objects.Media.mediaGetFilename' function.
-- 
-- /Since: 0.14/
mediaIsEmbedded ::
    (B.CallStack.HasCallStack, MonadIO m, IsMedia a) =>
    a
    -- ^ /@popplerMedia@/: a t'GI.Poppler.Objects.Media.Media'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if media clip is embedded, 'P.False' otherwise
mediaIsEmbedded :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMedia a) =>
a -> m Bool
mediaIsEmbedded a
popplerMedia = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Media
popplerMedia' <- a -> IO (Ptr Media)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMedia
    CInt
result <- Ptr Media -> IO CInt
poppler_media_is_embedded Ptr Media
popplerMedia'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMedia
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MediaIsEmbeddedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMedia a) => O.OverloadedMethod MediaIsEmbeddedMethodInfo a signature where
    overloadedMethod = mediaIsEmbedded

instance O.OverloadedMethodInfo MediaIsEmbeddedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Media.mediaIsEmbedded",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Media.html#v:mediaIsEmbedded"
        }


#endif

-- method Media::save
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_media"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Media" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMedia" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of file to save"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "poppler_media_save" poppler_media_save :: 
    Ptr Media ->                            -- poppler_media : TInterface (Name {namespace = "Poppler", name = "Media"})
    CString ->                              -- filename : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Saves embedded stream of /@popplerMedia@/ to a file indicated by /@filename@/.
-- If /@error@/ is set, 'P.False' will be returned.
-- Possible errors include those in the @/G_FILE_ERROR/@ domain
-- and whatever the save function generates.
-- 
-- /Since: 0.14/
mediaSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsMedia a) =>
    a
    -- ^ /@popplerMedia@/: a t'GI.Poppler.Objects.Media.Media'
    -> T.Text
    -- ^ /@filename@/: name of file to save
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mediaSave :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMedia a) =>
a -> Text -> m ()
mediaSave a
popplerMedia Text
filename = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Media
popplerMedia' <- a -> IO (Ptr Media)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMedia
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Media -> CString -> Ptr (Ptr GError) -> IO CInt
poppler_media_save Ptr Media
popplerMedia' CString
filename'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMedia
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
     )

#if defined(ENABLE_OVERLOADING)
data MediaSaveMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsMedia a) => O.OverloadedMethod MediaSaveMethodInfo a signature where
    overloadedMethod = mediaSave

instance O.OverloadedMethodInfo MediaSaveMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Media.mediaSave",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Media.html#v:mediaSave"
        }


#endif

-- method Media::save_to_callback
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_media"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Media" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMedia" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "save_func"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "MediaSaveFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a function that is called to save each block of data that the save routine generates."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to the save function."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "poppler_media_save_to_callback" poppler_media_save_to_callback :: 
    Ptr Media ->                            -- poppler_media : TInterface (Name {namespace = "Poppler", name = "Media"})
    FunPtr Poppler.Callbacks.C_MediaSaveFunc -> -- save_func : TInterface (Name {namespace = "Poppler", name = "MediaSaveFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Saves embedded stream of /@popplerMedia@/ by feeding the produced data to /@saveFunc@/. Can be used
-- when you want to store the media clip stream to something other than a file, such as
-- an in-memory buffer or a socket. If /@error@/ is set, 'P.False' will be
-- returned. Possible errors include those in the @/G_FILE_ERROR/@ domain and
-- whatever the save function generates.
-- 
-- /Since: 0.14/
mediaSaveToCallback ::
    (B.CallStack.HasCallStack, MonadIO m, IsMedia a) =>
    a
    -- ^ /@popplerMedia@/: a t'GI.Poppler.Objects.Media.Media'
    -> FunPtr Poppler.Callbacks.C_MediaSaveFunc
    -- ^ /@saveFunc@/: a function that is called to save each block of data that the save routine generates.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mediaSaveToCallback :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMedia a) =>
a -> FunPtr C_MediaSaveFunc -> m ()
mediaSaveToCallback a
popplerMedia FunPtr C_MediaSaveFunc
saveFunc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Media
popplerMedia' <- a -> IO (Ptr Media)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMedia
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Media
-> FunPtr C_MediaSaveFunc -> Ptr () -> Ptr (Ptr GError) -> IO CInt
poppler_media_save_to_callback Ptr Media
popplerMedia' FunPtr C_MediaSaveFunc
saveFunc Ptr ()
forall a. Ptr a
userData
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_MediaSaveFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_MediaSaveFunc
saveFunc
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMedia
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_MediaSaveFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_MediaSaveFunc
saveFunc
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data MediaSaveToCallbackMethodInfo
instance (signature ~ (FunPtr Poppler.Callbacks.C_MediaSaveFunc -> m ()), MonadIO m, IsMedia a) => O.OverloadedMethod MediaSaveToCallbackMethodInfo a signature where
    overloadedMethod = mediaSaveToCallback

instance O.OverloadedMethodInfo MediaSaveToCallbackMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Media.mediaSaveToCallback",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Media.html#v:mediaSaveToCallback"
        }


#endif