{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This is a legacy format and you should avoid to use it. The formatter
-- is really not in good shape and is deprecated.

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

module GI.GES.Objects.PitiviFormatter
    ( 

-- * Exported types
    PitiviFormatter(..)                     ,
    IsPitiviFormatter                       ,
    toPitiviFormatter                       ,


 -- * 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"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [loadFromUri]("GI.GES.Objects.Formatter#g:method:loadFromUri"), [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"), [saveToUri]("GI.GES.Objects.Formatter#g:method:saveToUri"), [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
-- [getAsset]("GI.GES.Interfaces.Extractable#g:method:getAsset"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getId]("GI.GES.Interfaces.Extractable#g:method:getId"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setAsset]("GI.GES.Interfaces.Extractable#g:method:setAsset"), [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)
    ResolvePitiviFormatterMethod            ,
#endif

-- ** new #method:new#

    pitiviFormatterNew                      ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 {-# SOURCE #-} qualified GI.GES.Interfaces.Extractable as GES.Extractable
import {-# SOURCE #-} qualified GI.GES.Objects.Formatter as GES.Formatter
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "ges_pitivi_formatter_get_type"
    c_ges_pitivi_formatter_get_type :: IO B.Types.GType

instance B.Types.TypedObject PitiviFormatter where
    glibType :: IO GType
glibType = IO GType
c_ges_pitivi_formatter_get_type

instance B.Types.GObject PitiviFormatter

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

instance O.HasParentTypes PitiviFormatter
type instance O.ParentTypes PitiviFormatter = '[GES.Formatter.Formatter, GObject.Object.Object, GES.Extractable.Extractable]

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

-- | Convert 'PitiviFormatter' 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 PitiviFormatter) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ges_pitivi_formatter_get_type
    gvalueSet_ :: Ptr GValue -> Maybe PitiviFormatter -> IO ()
gvalueSet_ Ptr GValue
gv Maybe PitiviFormatter
P.Nothing = Ptr GValue -> Ptr PitiviFormatter -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr PitiviFormatter
forall a. Ptr a
FP.nullPtr :: FP.Ptr PitiviFormatter)
    gvalueSet_ Ptr GValue
gv (P.Just PitiviFormatter
obj) = PitiviFormatter -> (Ptr PitiviFormatter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PitiviFormatter
obj (Ptr GValue -> Ptr PitiviFormatter -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe PitiviFormatter)
gvalueGet_ Ptr GValue
gv = do
        Ptr PitiviFormatter
ptr <- Ptr GValue -> IO (Ptr PitiviFormatter)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr PitiviFormatter)
        if Ptr PitiviFormatter
ptr Ptr PitiviFormatter -> Ptr PitiviFormatter -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr PitiviFormatter
forall a. Ptr a
FP.nullPtr
        then PitiviFormatter -> Maybe PitiviFormatter
forall a. a -> Maybe a
P.Just (PitiviFormatter -> Maybe PitiviFormatter)
-> IO PitiviFormatter -> IO (Maybe PitiviFormatter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr PitiviFormatter -> PitiviFormatter)
-> Ptr PitiviFormatter -> IO PitiviFormatter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr PitiviFormatter -> PitiviFormatter
PitiviFormatter Ptr PitiviFormatter
ptr
        else Maybe PitiviFormatter -> IO (Maybe PitiviFormatter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PitiviFormatter
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolvePitiviFormatterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePitiviFormatterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePitiviFormatterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePitiviFormatterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePitiviFormatterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePitiviFormatterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePitiviFormatterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePitiviFormatterMethod "loadFromUri" o = GES.Formatter.FormatterLoadFromUriMethodInfo
    ResolvePitiviFormatterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePitiviFormatterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePitiviFormatterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePitiviFormatterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePitiviFormatterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePitiviFormatterMethod "saveToUri" o = GES.Formatter.FormatterSaveToUriMethodInfo
    ResolvePitiviFormatterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePitiviFormatterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePitiviFormatterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePitiviFormatterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePitiviFormatterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePitiviFormatterMethod "getAsset" o = GES.Extractable.ExtractableGetAssetMethodInfo
    ResolvePitiviFormatterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePitiviFormatterMethod "getId" o = GES.Extractable.ExtractableGetIdMethodInfo
    ResolvePitiviFormatterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePitiviFormatterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePitiviFormatterMethod "setAsset" o = GES.Extractable.ExtractableSetAssetMethodInfo
    ResolvePitiviFormatterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePitiviFormatterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePitiviFormatterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePitiviFormatterMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePitiviFormatterMethod t PitiviFormatter, O.OverloadedMethod info PitiviFormatter p) => OL.IsLabel t (PitiviFormatter -> 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 ~ ResolvePitiviFormatterMethod t PitiviFormatter, O.OverloadedMethod info PitiviFormatter p, R.HasField t PitiviFormatter p) => R.HasField t PitiviFormatter p where
    getField = O.overloadedMethod @info

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PitiviFormatter
type instance O.AttributeList PitiviFormatter = PitiviFormatterAttributeList
type PitiviFormatterAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PitiviFormatter = PitiviFormatterSignalList
type PitiviFormatterSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method PitiviFormatter::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GES" , name = "PitiviFormatter" })
-- throws : False
-- Skip return : False

foreign import ccall "ges_pitivi_formatter_new" ges_pitivi_formatter_new :: 
    IO (Ptr PitiviFormatter)

-- | /No description available in the introspection data./
pitiviFormatterNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m PitiviFormatter
pitiviFormatterNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m PitiviFormatter
pitiviFormatterNew  = IO PitiviFormatter -> m PitiviFormatter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PitiviFormatter -> m PitiviFormatter)
-> IO PitiviFormatter -> m PitiviFormatter
forall a b. (a -> b) -> a -> b
$ do
    Ptr PitiviFormatter
result <- IO (Ptr PitiviFormatter)
ges_pitivi_formatter_new
    Text -> Ptr PitiviFormatter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pitiviFormatterNew" Ptr PitiviFormatter
result
    PitiviFormatter
result' <- ((ManagedPtr PitiviFormatter -> PitiviFormatter)
-> Ptr PitiviFormatter -> IO PitiviFormatter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PitiviFormatter -> PitiviFormatter
PitiviFormatter) Ptr PitiviFormatter
result
    PitiviFormatter -> IO PitiviFormatter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PitiviFormatter
result'

#if defined(ENABLE_OVERLOADING)
#endif