{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Base class for timeline data serialization and deserialization.

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

module GI.GES.Objects.Formatter
    ( 

-- * Exported types
    Formatter(..)                           ,
    IsFormatter                             ,
    toFormatter                             ,


 -- * 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)
    ResolveFormatterMethod                  ,
#endif

-- ** canLoadUri #method:canLoadUri#

    formatterCanLoadUri                     ,


-- ** canSaveUri #method:canSaveUri#

    formatterCanSaveUri                     ,


-- ** getDefault #method:getDefault#

    formatterGetDefault                     ,


-- ** loadFromUri #method:loadFromUri#

#if defined(ENABLE_OVERLOADING)
    FormatterLoadFromUriMethodInfo          ,
#endif
    formatterLoadFromUri                    ,


-- ** saveToUri #method:saveToUri#

#if defined(ENABLE_OVERLOADING)
    FormatterSaveToUriMethodInfo            ,
#endif
    formatterSaveToUri                      ,




    ) 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.Asset as GES.Asset
import {-# SOURCE #-} qualified GI.GES.Objects.Timeline as GES.Timeline
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "ges_formatter_get_type"
    c_ges_formatter_get_type :: IO B.Types.GType

instance B.Types.TypedObject Formatter where
    glibType :: IO GType
glibType = IO GType
c_ges_formatter_get_type

instance B.Types.GObject Formatter

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

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

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

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

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

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Formatter::load_from_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formatter"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Formatter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GESFormatter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GESTimeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gchar * pointing to a URI"
--                 , 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 "ges_formatter_load_from_uri" ges_formatter_load_from_uri :: 
    Ptr Formatter ->                        -- formatter : TInterface (Name {namespace = "GES", name = "Formatter"})
    Ptr GES.Timeline.Timeline ->            -- timeline : TInterface (Name {namespace = "GES", name = "Timeline"})
    CString ->                              -- uri : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED formatterLoadFromUri ["(Since version 1.18)","Use /@gesTimelineLoadFromUri@/"] #-}
-- | Load data from the given URI into timeline.
formatterLoadFromUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormatter a, GES.Timeline.IsTimeline b) =>
    a
    -- ^ /@formatter@/: a t'GI.GES.Objects.Formatter.Formatter'
    -> b
    -- ^ /@timeline@/: a t'GI.GES.Objects.Timeline.Timeline'
    -> T.Text
    -- ^ /@uri@/: a @/gchar/@ * pointing to a URI
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
formatterLoadFromUri :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFormatter a, IsTimeline b) =>
a -> b -> Text -> m ()
formatterLoadFromUri a
formatter b
timeline Text
uri = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Formatter
formatter' <- a -> IO (Ptr Formatter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
formatter
    Ptr Timeline
timeline' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
timeline
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    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 Formatter
-> Ptr Timeline -> CString -> Ptr (Ptr GError) -> IO CInt
ges_formatter_load_from_uri Ptr Formatter
formatter' Ptr Timeline
timeline' CString
uri'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
formatter
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
timeline
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
data FormatterLoadFromUriMethodInfo
instance (signature ~ (b -> T.Text -> m ()), MonadIO m, IsFormatter a, GES.Timeline.IsTimeline b) => O.OverloadedMethod FormatterLoadFromUriMethodInfo a signature where
    overloadedMethod = formatterLoadFromUri

instance O.OverloadedMethodInfo FormatterLoadFromUriMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Formatter.formatterLoadFromUri",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Formatter.html#v:formatterLoadFromUri"
        })


#endif

-- method Formatter::save_to_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formatter"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Formatter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GESFormatter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GESTimeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gchar * pointing to a URI"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "overwrite"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to overwrite file if it exists"
--                 , 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 "ges_formatter_save_to_uri" ges_formatter_save_to_uri :: 
    Ptr Formatter ->                        -- formatter : TInterface (Name {namespace = "GES", name = "Formatter"})
    Ptr GES.Timeline.Timeline ->            -- timeline : TInterface (Name {namespace = "GES", name = "Timeline"})
    CString ->                              -- uri : TBasicType TUTF8
    CInt ->                                 -- overwrite : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED formatterSaveToUri ["(Since version 1.18)","Use /@gesTimelineSaveToUri@/"] #-}
-- | Save data from timeline to the given URI.
formatterSaveToUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormatter a, GES.Timeline.IsTimeline b) =>
    a
    -- ^ /@formatter@/: a t'GI.GES.Objects.Formatter.Formatter'
    -> b
    -- ^ /@timeline@/: a t'GI.GES.Objects.Timeline.Timeline'
    -> T.Text
    -- ^ /@uri@/: a @/gchar/@ * pointing to a URI
    -> Bool
    -- ^ /@overwrite@/: 'P.True' to overwrite file if it exists
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
formatterSaveToUri :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFormatter a, IsTimeline b) =>
a -> b -> Text -> Bool -> m ()
formatterSaveToUri a
formatter b
timeline Text
uri Bool
overwrite = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Formatter
formatter' <- a -> IO (Ptr Formatter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
formatter
    Ptr Timeline
timeline' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
timeline
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    let overwrite' :: CInt
overwrite' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
overwrite
    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 Formatter
-> Ptr Timeline -> CString -> CInt -> Ptr (Ptr GError) -> IO CInt
ges_formatter_save_to_uri Ptr Formatter
formatter' Ptr Timeline
timeline' CString
uri' CInt
overwrite'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
formatter
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
timeline
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
data FormatterSaveToUriMethodInfo
instance (signature ~ (b -> T.Text -> Bool -> m ()), MonadIO m, IsFormatter a, GES.Timeline.IsTimeline b) => O.OverloadedMethod FormatterSaveToUriMethodInfo a signature where
    overloadedMethod = formatterSaveToUri

instance O.OverloadedMethodInfo FormatterSaveToUriMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Formatter.formatterSaveToUri",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Formatter.html#v:formatterSaveToUri"
        })


#endif

-- method Formatter::can_load_uri
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gchar * pointing to the URI"
--                 , 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 "ges_formatter_can_load_uri" ges_formatter_can_load_uri :: 
    CString ->                              -- uri : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Checks if there is a t'GI.GES.Objects.Formatter.Formatter' available which can load a t'GI.GES.Objects.Timeline.Timeline'
-- from the given URI.
formatterCanLoadUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: a @/gchar/@ * pointing to the URI
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
formatterCanLoadUri :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
formatterCanLoadUri Text
uri = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    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
$ CString -> Ptr (Ptr GError) -> IO CInt
ges_formatter_can_load_uri CString
uri'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Formatter::can_save_uri
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gchar * pointing to a URI"
--                 , 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 "ges_formatter_can_save_uri" ges_formatter_can_save_uri :: 
    CString ->                              -- uri : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Returns TRUE if there is a t'GI.GES.Objects.Formatter.Formatter' available which can save a
-- t'GI.GES.Objects.Timeline.Timeline' to the given URI.
formatterCanSaveUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: a @/gchar/@ * pointing to a URI
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
formatterCanSaveUri :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
formatterCanSaveUri Text
uri = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    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
$ CString -> Ptr (Ptr GError) -> IO CInt
ges_formatter_can_save_uri CString
uri'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Formatter::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "Asset" })
-- throws : False
-- Skip return : False

foreign import ccall "ges_formatter_get_default" ges_formatter_get_default :: 
    IO (Ptr GES.Asset.Asset)

-- | Get the default t'GI.GES.Objects.Asset.Asset' to use as formatter. It will return
-- the asset for the t'GI.GES.Objects.Formatter.Formatter' that has the highest /@rank@/
formatterGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m GES.Asset.Asset
    -- ^ __Returns:__ The t'GI.GES.Objects.Asset.Asset' for the formatter with highest /@rank@/
formatterGetDefault :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Asset
formatterGetDefault  = IO Asset -> m Asset
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Asset -> m Asset) -> IO Asset -> m Asset
forall a b. (a -> b) -> a -> b
$ do
    Ptr Asset
result <- IO (Ptr Asset)
ges_formatter_get_default
    Text -> Ptr Asset -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"formatterGetDefault" Ptr Asset
result
    Asset
result' <- ((ManagedPtr Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Asset -> Asset
GES.Asset.Asset) Ptr Asset
result
    Asset -> IO Asset
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Asset
result'

#if defined(ENABLE_OVERLOADING)
#endif