{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The GStreamer core provides a GstSystemClock based on the system time.
-- Asynchronous callbacks are scheduled from an internal thread.
-- 
-- Clock implementors are encouraged to subclass this systemclock as it
-- implements the async notification.
-- 
-- Subclasses can however override all of the important methods for sync and
-- async notifications to implement their own callback methods or blocking
-- wait operations.

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

module GI.Gst.Objects.SystemClock
    ( 

-- * Exported types
    SystemClock(..)                         ,
    IsSystemClock                           ,
    toSystemClock                           ,
    noSystemClock                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSystemClockMethod                ,
#endif


-- ** obtain #method:obtain#

    systemClockObtain                       ,


-- ** setDefault #method:setDefault#

    systemClockSetDefault                   ,




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

#if defined(ENABLE_OVERLOADING)
    SystemClockClockTypePropertyInfo        ,
#endif
    constructSystemClockClockType           ,
    getSystemClockClockType                 ,
    setSystemClockClockType                 ,
#if defined(ENABLE_OVERLOADING)
    systemClockClockType                    ,
#endif




    ) 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.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 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.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Objects.Clock as Gst.Clock
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object

-- | Memory-managed wrapper type.
newtype SystemClock = SystemClock (ManagedPtr SystemClock)
    deriving (SystemClock -> SystemClock -> Bool
(SystemClock -> SystemClock -> Bool)
-> (SystemClock -> SystemClock -> Bool) -> Eq SystemClock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemClock -> SystemClock -> Bool
$c/= :: SystemClock -> SystemClock -> Bool
== :: SystemClock -> SystemClock -> Bool
$c== :: SystemClock -> SystemClock -> Bool
Eq)
foreign import ccall "gst_system_clock_get_type"
    c_gst_system_clock_get_type :: IO GType

instance GObject SystemClock where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_system_clock_get_type
    

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

-- | Type class for types which can be safely cast to `SystemClock`, for instance with `toSystemClock`.
class (GObject o, O.IsDescendantOf SystemClock o) => IsSystemClock o
instance (GObject o, O.IsDescendantOf SystemClock o) => IsSystemClock o

instance O.HasParentTypes SystemClock
type instance O.ParentTypes SystemClock = '[Gst.Clock.Clock, Gst.Object.Object, GObject.Object.Object]

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

-- | A convenience alias for `Nothing` :: `Maybe` `SystemClock`.
noSystemClock :: Maybe SystemClock
noSystemClock :: Maybe SystemClock
noSystemClock = Maybe SystemClock
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveSystemClockMethod (t :: Symbol) (o :: *) :: * where
    ResolveSystemClockMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveSystemClockMethod "addObservation" o = Gst.Clock.ClockAddObservationMethodInfo
    ResolveSystemClockMethod "addObservationUnapplied" o = Gst.Clock.ClockAddObservationUnappliedMethodInfo
    ResolveSystemClockMethod "adjustUnlocked" o = Gst.Clock.ClockAdjustUnlockedMethodInfo
    ResolveSystemClockMethod "adjustWithCalibration" o = Gst.Clock.ClockAdjustWithCalibrationMethodInfo
    ResolveSystemClockMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSystemClockMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSystemClockMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveSystemClockMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSystemClockMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSystemClockMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSystemClockMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveSystemClockMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveSystemClockMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveSystemClockMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveSystemClockMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSystemClockMethod "isSynced" o = Gst.Clock.ClockIsSyncedMethodInfo
    ResolveSystemClockMethod "newPeriodicId" o = Gst.Clock.ClockNewPeriodicIdMethodInfo
    ResolveSystemClockMethod "newSingleShotId" o = Gst.Clock.ClockNewSingleShotIdMethodInfo
    ResolveSystemClockMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSystemClockMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSystemClockMethod "periodicIdReinit" o = Gst.Clock.ClockPeriodicIdReinitMethodInfo
    ResolveSystemClockMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveSystemClockMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSystemClockMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveSystemClockMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSystemClockMethod "singleShotIdReinit" o = Gst.Clock.ClockSingleShotIdReinitMethodInfo
    ResolveSystemClockMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSystemClockMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSystemClockMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveSystemClockMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveSystemClockMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSystemClockMethod "unadjustUnlocked" o = Gst.Clock.ClockUnadjustUnlockedMethodInfo
    ResolveSystemClockMethod "unadjustWithCalibration" o = Gst.Clock.ClockUnadjustWithCalibrationMethodInfo
    ResolveSystemClockMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveSystemClockMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveSystemClockMethod "waitForSync" o = Gst.Clock.ClockWaitForSyncMethodInfo
    ResolveSystemClockMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSystemClockMethod "getCalibration" o = Gst.Clock.ClockGetCalibrationMethodInfo
    ResolveSystemClockMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveSystemClockMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveSystemClockMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSystemClockMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveSystemClockMethod "getInternalTime" o = Gst.Clock.ClockGetInternalTimeMethodInfo
    ResolveSystemClockMethod "getMaster" o = Gst.Clock.ClockGetMasterMethodInfo
    ResolveSystemClockMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveSystemClockMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveSystemClockMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveSystemClockMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSystemClockMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSystemClockMethod "getResolution" o = Gst.Clock.ClockGetResolutionMethodInfo
    ResolveSystemClockMethod "getTime" o = Gst.Clock.ClockGetTimeMethodInfo
    ResolveSystemClockMethod "getTimeout" o = Gst.Clock.ClockGetTimeoutMethodInfo
    ResolveSystemClockMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveSystemClockMethod "setCalibration" o = Gst.Clock.ClockSetCalibrationMethodInfo
    ResolveSystemClockMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveSystemClockMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveSystemClockMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveSystemClockMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSystemClockMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSystemClockMethod "setMaster" o = Gst.Clock.ClockSetMasterMethodInfo
    ResolveSystemClockMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveSystemClockMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveSystemClockMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSystemClockMethod "setResolution" o = Gst.Clock.ClockSetResolutionMethodInfo
    ResolveSystemClockMethod "setSynced" o = Gst.Clock.ClockSetSyncedMethodInfo
    ResolveSystemClockMethod "setTimeout" o = Gst.Clock.ClockSetTimeoutMethodInfo
    ResolveSystemClockMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "clock-type"
   -- Type: TInterface (Name {namespace = "Gst", name = "ClockType"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@clock-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' systemClock #clockType
-- @
getSystemClockClockType :: (MonadIO m, IsSystemClock o) => o -> m Gst.Enums.ClockType
getSystemClockClockType :: o -> m ClockType
getSystemClockClockType obj :: o
obj = IO ClockType -> m ClockType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClockType -> m ClockType) -> IO ClockType -> m ClockType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ClockType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "clock-type"

-- | Set the value of the “@clock-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' systemClock [ #clockType 'Data.GI.Base.Attributes.:=' value ]
-- @
setSystemClockClockType :: (MonadIO m, IsSystemClock o) => o -> Gst.Enums.ClockType -> m ()
setSystemClockClockType :: o -> ClockType -> m ()
setSystemClockClockType obj :: o
obj val :: ClockType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> ClockType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj "clock-type" ClockType
val

-- | Construct a `GValueConstruct` with valid value for the “@clock-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSystemClockClockType :: (IsSystemClock o) => Gst.Enums.ClockType -> IO (GValueConstruct o)
constructSystemClockClockType :: ClockType -> IO (GValueConstruct o)
constructSystemClockClockType val :: ClockType
val = String -> ClockType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "clock-type" ClockType
val

#if defined(ENABLE_OVERLOADING)
data SystemClockClockTypePropertyInfo
instance AttrInfo SystemClockClockTypePropertyInfo where
    type AttrAllowedOps SystemClockClockTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SystemClockClockTypePropertyInfo = IsSystemClock
    type AttrSetTypeConstraint SystemClockClockTypePropertyInfo = (~) Gst.Enums.ClockType
    type AttrTransferTypeConstraint SystemClockClockTypePropertyInfo = (~) Gst.Enums.ClockType
    type AttrTransferType SystemClockClockTypePropertyInfo = Gst.Enums.ClockType
    type AttrGetType SystemClockClockTypePropertyInfo = Gst.Enums.ClockType
    type AttrLabel SystemClockClockTypePropertyInfo = "clock-type"
    type AttrOrigin SystemClockClockTypePropertyInfo = SystemClock
    attrGet = getSystemClockClockType
    attrSet = setSystemClockClockType
    attrTransfer _ v = do
        return v
    attrConstruct = constructSystemClockClockType
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SystemClock
type instance O.AttributeList SystemClock = SystemClockAttributeList
type SystemClockAttributeList = ('[ '("clockType", SystemClockClockTypePropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("timeout", Gst.Clock.ClockTimeoutPropertyInfo), '("windowSize", Gst.Clock.ClockWindowSizePropertyInfo), '("windowThreshold", Gst.Clock.ClockWindowThresholdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
systemClockClockType :: AttrLabelProxy "clockType"
systemClockClockType = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SystemClock = SystemClockSignalList
type SystemClockSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("synced", Gst.Clock.ClockSyncedSignalInfo)] :: [(Symbol, *)])

#endif

-- method SystemClock::obtain
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Clock" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_system_clock_obtain" gst_system_clock_obtain :: 
    IO (Ptr Gst.Clock.Clock)

-- | Get a handle to the default system clock. The refcount of the
-- clock will be increased so you need to unref the clock after
-- usage.
systemClockObtain ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gst.Clock.Clock
    -- ^ __Returns:__ the default clock.
    -- 
    -- MT safe.
systemClockObtain :: m Clock
systemClockObtain  = IO Clock -> m Clock
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Clock -> m Clock) -> IO Clock -> m Clock
forall a b. (a -> b) -> a -> b
$ do
    Ptr Clock
result <- IO (Ptr Clock)
gst_system_clock_obtain
    Text -> Ptr Clock -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "systemClockObtain" Ptr Clock
result
    Clock
result' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Clock -> Clock
Gst.Clock.Clock) Ptr Clock
result
    Clock -> IO Clock
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SystemClock::set_default
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "new_clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_system_clock_set_default" gst_system_clock_set_default :: 
    Ptr Gst.Clock.Clock ->                  -- new_clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO ()

-- | Sets the default system clock that can be obtained with
-- 'GI.Gst.Objects.SystemClock.systemClockObtain'.
-- 
-- This is mostly used for testing and debugging purposes when you
-- want to have control over the time reported by the default system
-- clock.
-- 
-- MT safe.
-- 
-- /Since: 1.4/
systemClockSetDefault ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Clock.IsClock a) =>
    Maybe (a)
    -- ^ /@newClock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> m ()
systemClockSetDefault :: Maybe a -> m ()
systemClockSetDefault newClock :: Maybe a
newClock = 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 Clock
maybeNewClock <- case Maybe a
newClock of
        Nothing -> Ptr Clock -> IO (Ptr Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Clock
forall a. Ptr a
nullPtr
        Just jNewClock :: a
jNewClock -> do
            Ptr Clock
jNewClock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jNewClock
            Ptr Clock -> IO (Ptr Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Clock
jNewClock'
    Ptr Clock -> IO ()
gst_system_clock_set_default Ptr Clock
maybeNewClock
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
newClock a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif