{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The GRWLock struct is an opaque data structure to represent a
-- reader-writer lock. It is similar to a t'GI.GLib.Unions.Mutex.Mutex' in that it allows
-- multiple threads to coordinate access to a shared resource.
-- 
-- The difference to a mutex is that a reader-writer lock discriminates
-- between read-only (\'reader\') and full (\'writer\') access. While only
-- one thread at a time is allowed write access (by holding the \'writer\'
-- lock via 'GI.GLib.Structs.RWLock.rWLockWriterLock'), multiple threads can gain
-- simultaneous read-only access (by holding the \'reader\' lock via
-- 'GI.GLib.Structs.RWLock.rWLockReaderLock').
-- 
-- It is unspecified whether readers or writers have priority in acquiring the
-- lock when a reader already holds the lock and a writer is queued to acquire
-- it.
-- 
-- Here is an example for an array with access functions:
-- 
-- === /C code/
-- >
-- >  GRWLock lock;
-- >  GPtrArray *array;
-- >
-- >  gpointer
-- >  my_array_get (guint index)
-- >  {
-- >    gpointer retval = NULL;
-- >
-- >    if (!array)
-- >      return NULL;
-- >
-- >    g_rw_lock_reader_lock (&lock);
-- >    if (index < array->len)
-- >      retval = g_ptr_array_index (array, index);
-- >    g_rw_lock_reader_unlock (&lock);
-- >
-- >    return retval;
-- >  }
-- >
-- >  void
-- >  my_array_set (guint index, gpointer data)
-- >  {
-- >    g_rw_lock_writer_lock (&lock);
-- >
-- >    if (!array)
-- >      array = g_ptr_array_new ();
-- >
-- >    if (index >= array->len)
-- >      g_ptr_array_set_size (array, index+1);
-- >    g_ptr_array_index (array, index) = data;
-- >
-- >    g_rw_lock_writer_unlock (&lock);
-- >  }
-- > 
-- 
-- This example shows an array which can be accessed by many readers
-- (the @/my_array_get()/@ function) simultaneously, whereas the writers
-- (the @/my_array_set()/@ function) will only be allowed one at a time
-- and only if no readers currently access the array. This is because
-- of the potentially dangerous resizing of the array. Using these
-- functions is fully multi-thread safe now.
-- 
-- If a t'GI.GLib.Structs.RWLock.RWLock' is allocated in static storage then it can be used
-- without initialisation.  Otherwise, you should call
-- 'GI.GLib.Structs.RWLock.rWLockInit' on it and 'GI.GLib.Structs.RWLock.rWLockClear' when done.
-- 
-- A GRWLock should only be accessed with the g_rw_lock_ functions.
-- 
-- /Since: 2.32/

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

module GI.GLib.Structs.RWLock
    ( 

-- * Exported types
    RWLock(..)                              ,
    newZeroRWLock                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [clear]("GI.GLib.Structs.RWLock#g:method:clear"), [init]("GI.GLib.Structs.RWLock#g:method:init"), [readerLock]("GI.GLib.Structs.RWLock#g:method:readerLock"), [readerTrylock]("GI.GLib.Structs.RWLock#g:method:readerTrylock"), [readerUnlock]("GI.GLib.Structs.RWLock#g:method:readerUnlock"), [writerLock]("GI.GLib.Structs.RWLock#g:method:writerLock"), [writerTrylock]("GI.GLib.Structs.RWLock#g:method:writerTrylock"), [writerUnlock]("GI.GLib.Structs.RWLock#g:method:writerUnlock").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRWLockMethod                     ,
#endif

-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    RWLockClearMethodInfo                   ,
#endif
    rWLockClear                             ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    RWLockInitMethodInfo                    ,
#endif
    rWLockInit                              ,


-- ** readerLock #method:readerLock#

#if defined(ENABLE_OVERLOADING)
    RWLockReaderLockMethodInfo              ,
#endif
    rWLockReaderLock                        ,


-- ** readerTrylock #method:readerTrylock#

#if defined(ENABLE_OVERLOADING)
    RWLockReaderTrylockMethodInfo           ,
#endif
    rWLockReaderTrylock                     ,


-- ** readerUnlock #method:readerUnlock#

#if defined(ENABLE_OVERLOADING)
    RWLockReaderUnlockMethodInfo            ,
#endif
    rWLockReaderUnlock                      ,


-- ** writerLock #method:writerLock#

#if defined(ENABLE_OVERLOADING)
    RWLockWriterLockMethodInfo              ,
#endif
    rWLockWriterLock                        ,


-- ** writerTrylock #method:writerTrylock#

#if defined(ENABLE_OVERLOADING)
    RWLockWriterTrylockMethodInfo           ,
#endif
    rWLockWriterTrylock                     ,


-- ** writerUnlock #method:writerUnlock#

#if defined(ENABLE_OVERLOADING)
    RWLockWriterUnlockMethodInfo            ,
#endif
    rWLockWriterUnlock                      ,




    ) 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


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

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

instance BoxedPtr RWLock where
    boxedPtrCopy :: RWLock -> IO RWLock
boxedPtrCopy = \RWLock
p -> RWLock -> (Ptr RWLock -> IO RWLock) -> IO RWLock
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr RWLock
p (Int -> Ptr RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
16 (Ptr RWLock -> IO (Ptr RWLock))
-> (Ptr RWLock -> IO RWLock) -> Ptr RWLock -> IO RWLock
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr RWLock -> RWLock) -> Ptr RWLock -> IO RWLock
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr RWLock -> RWLock
RWLock)
    boxedPtrFree :: RWLock -> IO ()
boxedPtrFree = \RWLock
x -> RWLock -> (Ptr RWLock -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr RWLock
x Ptr RWLock -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr RWLock where
    boxedPtrCalloc :: IO (Ptr RWLock)
boxedPtrCalloc = Int -> IO (Ptr RWLock)
forall a. Int -> IO (Ptr a)
callocBytes Int
16


-- | Construct a `RWLock` struct initialized to zero.
newZeroRWLock :: MonadIO m => m RWLock
newZeroRWLock :: forall (m :: * -> *). MonadIO m => m RWLock
newZeroRWLock = IO RWLock -> m RWLock
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RWLock -> m RWLock) -> IO RWLock -> m RWLock
forall a b. (a -> b) -> a -> b
$ IO (Ptr RWLock)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr RWLock) -> (Ptr RWLock -> IO RWLock) -> IO RWLock
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr RWLock -> RWLock) -> Ptr RWLock -> IO RWLock
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr RWLock -> RWLock
RWLock

instance tag ~ 'AttrSet => Constructible RWLock tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr RWLock -> RWLock) -> [AttrOp RWLock tag] -> m RWLock
new ManagedPtr RWLock -> RWLock
_ [AttrOp RWLock tag]
attrs = do
        RWLock
o <- m RWLock
forall (m :: * -> *). MonadIO m => m RWLock
newZeroRWLock
        RWLock -> [AttrOp RWLock 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set RWLock
o [AttrOp RWLock tag]
[AttrOp RWLock 'AttrSet]
attrs
        RWLock -> m RWLock
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RWLock
o



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

-- method RWLock::clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rw_lock"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "RWLock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an initialized #GRWLock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_rw_lock_clear" g_rw_lock_clear :: 
    Ptr RWLock ->                           -- rw_lock : TInterface (Name {namespace = "GLib", name = "RWLock"})
    IO ()

-- | Frees the resources allocated to a lock with 'GI.GLib.Structs.RWLock.rWLockInit'.
-- 
-- This function should not be used with a t'GI.GLib.Structs.RWLock.RWLock' that has been
-- statically allocated.
-- 
-- Calling 'GI.GLib.Structs.RWLock.rWLockClear' when any thread holds the lock
-- leads to undefined behaviour.
-- 
-- /Since: 2.32/
rWLockClear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RWLock
    -- ^ /@rwLock@/: an initialized t'GI.GLib.Structs.RWLock.RWLock'
    -> m ()
rWLockClear :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RWLock -> m ()
rWLockClear RWLock
rwLock = 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 RWLock
rwLock' <- RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RWLock
rwLock
    Ptr RWLock -> IO ()
g_rw_lock_clear Ptr RWLock
rwLock'
    RWLock -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RWLock
rwLock
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RWLockClearMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RWLockClearMethodInfo RWLock signature where
    overloadedMethod = rWLockClear

instance O.OverloadedMethodInfo RWLockClearMethodInfo RWLock where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.RWLock.rWLockClear",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-RWLock.html#v:rWLockClear"
        })


#endif

-- method RWLock::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rw_lock"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "RWLock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an uninitialized #GRWLock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_rw_lock_init" g_rw_lock_init :: 
    Ptr RWLock ->                           -- rw_lock : TInterface (Name {namespace = "GLib", name = "RWLock"})
    IO ()

-- | Initializes a t'GI.GLib.Structs.RWLock.RWLock' so that it can be used.
-- 
-- This function is useful to initialize a lock that has been
-- allocated on the stack, or as part of a larger structure.  It is not
-- necessary to initialise a reader-writer lock that has been statically
-- allocated.
-- 
-- 
-- === /C code/
-- >
-- >  typedef struct {
-- >    GRWLock l;
-- >    ...
-- >  } Blob;
-- >
-- >Blob *b;
-- >
-- >b = g_new (Blob, 1);
-- >g_rw_lock_init (&b->l);
-- 
-- 
-- To undo the effect of 'GI.GLib.Structs.RWLock.rWLockInit' when a lock is no longer
-- needed, use 'GI.GLib.Structs.RWLock.rWLockClear'.
-- 
-- Calling 'GI.GLib.Structs.RWLock.rWLockInit' on an already initialized t'GI.GLib.Structs.RWLock.RWLock' leads
-- to undefined behaviour.
-- 
-- /Since: 2.32/
rWLockInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RWLock
    -- ^ /@rwLock@/: an uninitialized t'GI.GLib.Structs.RWLock.RWLock'
    -> m ()
rWLockInit :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RWLock -> m ()
rWLockInit RWLock
rwLock = 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 RWLock
rwLock' <- RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RWLock
rwLock
    Ptr RWLock -> IO ()
g_rw_lock_init Ptr RWLock
rwLock'
    RWLock -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RWLock
rwLock
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RWLockInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RWLockInitMethodInfo RWLock signature where
    overloadedMethod = rWLockInit

instance O.OverloadedMethodInfo RWLockInitMethodInfo RWLock where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.RWLock.rWLockInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-RWLock.html#v:rWLockInit"
        })


#endif

-- method RWLock::reader_lock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rw_lock"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "RWLock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRWLock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_rw_lock_reader_lock" g_rw_lock_reader_lock :: 
    Ptr RWLock ->                           -- rw_lock : TInterface (Name {namespace = "GLib", name = "RWLock"})
    IO ()

-- | Obtain a read lock on /@rwLock@/. If another thread currently holds
-- the write lock on /@rwLock@/, the current thread will block until the
-- write lock was (held and) released. If another thread does not hold
-- the write lock, but is waiting for it, it is implementation defined
-- whether the reader or writer will block. Read locks can be taken
-- recursively.
-- 
-- Calling 'GI.GLib.Structs.RWLock.rWLockReaderLock' while the current thread already
-- owns a write lock leads to undefined behaviour. Read locks however
-- can be taken recursively, in which case you need to make sure to
-- call 'GI.GLib.Structs.RWLock.rWLockReaderUnlock' the same amount of times.
-- 
-- It is implementation-defined how many read locks are allowed to be
-- held on the same lock simultaneously. If the limit is hit,
-- or if a deadlock is detected, a critical warning will be emitted.
-- 
-- /Since: 2.32/
rWLockReaderLock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RWLock
    -- ^ /@rwLock@/: a t'GI.GLib.Structs.RWLock.RWLock'
    -> m ()
rWLockReaderLock :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RWLock -> m ()
rWLockReaderLock RWLock
rwLock = 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 RWLock
rwLock' <- RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RWLock
rwLock
    Ptr RWLock -> IO ()
g_rw_lock_reader_lock Ptr RWLock
rwLock'
    RWLock -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RWLock
rwLock
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RWLockReaderLockMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RWLockReaderLockMethodInfo RWLock signature where
    overloadedMethod = rWLockReaderLock

instance O.OverloadedMethodInfo RWLockReaderLockMethodInfo RWLock where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.RWLock.rWLockReaderLock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-RWLock.html#v:rWLockReaderLock"
        })


#endif

-- method RWLock::reader_trylock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rw_lock"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "RWLock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRWLock" , 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 "g_rw_lock_reader_trylock" g_rw_lock_reader_trylock :: 
    Ptr RWLock ->                           -- rw_lock : TInterface (Name {namespace = "GLib", name = "RWLock"})
    IO CInt

-- | Tries to obtain a read lock on /@rwLock@/ and returns 'P.True' if
-- the read lock was successfully obtained. Otherwise it
-- returns 'P.False'.
-- 
-- /Since: 2.32/
rWLockReaderTrylock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RWLock
    -- ^ /@rwLock@/: a t'GI.GLib.Structs.RWLock.RWLock'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@rwLock@/ could be locked
rWLockReaderTrylock :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RWLock -> m Bool
rWLockReaderTrylock RWLock
rwLock = IO Bool -> m Bool
forall a. IO a -> m a
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 RWLock
rwLock' <- RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RWLock
rwLock
    CInt
result <- Ptr RWLock -> IO CInt
g_rw_lock_reader_trylock Ptr RWLock
rwLock'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RWLock -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RWLock
rwLock
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RWLockReaderTrylockMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod RWLockReaderTrylockMethodInfo RWLock signature where
    overloadedMethod = rWLockReaderTrylock

instance O.OverloadedMethodInfo RWLockReaderTrylockMethodInfo RWLock where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.RWLock.rWLockReaderTrylock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-RWLock.html#v:rWLockReaderTrylock"
        })


#endif

-- method RWLock::reader_unlock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rw_lock"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "RWLock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRWLock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_rw_lock_reader_unlock" g_rw_lock_reader_unlock :: 
    Ptr RWLock ->                           -- rw_lock : TInterface (Name {namespace = "GLib", name = "RWLock"})
    IO ()

-- | Release a read lock on /@rwLock@/.
-- 
-- Calling 'GI.GLib.Structs.RWLock.rWLockReaderUnlock' on a lock that is not held
-- by the current thread leads to undefined behaviour.
-- 
-- /Since: 2.32/
rWLockReaderUnlock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RWLock
    -- ^ /@rwLock@/: a t'GI.GLib.Structs.RWLock.RWLock'
    -> m ()
rWLockReaderUnlock :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RWLock -> m ()
rWLockReaderUnlock RWLock
rwLock = 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 RWLock
rwLock' <- RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RWLock
rwLock
    Ptr RWLock -> IO ()
g_rw_lock_reader_unlock Ptr RWLock
rwLock'
    RWLock -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RWLock
rwLock
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RWLockReaderUnlockMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RWLockReaderUnlockMethodInfo RWLock signature where
    overloadedMethod = rWLockReaderUnlock

instance O.OverloadedMethodInfo RWLockReaderUnlockMethodInfo RWLock where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.RWLock.rWLockReaderUnlock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-RWLock.html#v:rWLockReaderUnlock"
        })


#endif

-- method RWLock::writer_lock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rw_lock"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "RWLock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRWLock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_rw_lock_writer_lock" g_rw_lock_writer_lock :: 
    Ptr RWLock ->                           -- rw_lock : TInterface (Name {namespace = "GLib", name = "RWLock"})
    IO ()

-- | Obtain a write lock on /@rwLock@/. If another thread currently holds
-- a read or write lock on /@rwLock@/, the current thread will block
-- until all other threads have dropped their locks on /@rwLock@/.
-- 
-- Calling 'GI.GLib.Structs.RWLock.rWLockWriterLock' while the current thread already
-- owns a read or write lock on /@rwLock@/ leads to undefined behaviour.
-- 
-- /Since: 2.32/
rWLockWriterLock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RWLock
    -- ^ /@rwLock@/: a t'GI.GLib.Structs.RWLock.RWLock'
    -> m ()
rWLockWriterLock :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RWLock -> m ()
rWLockWriterLock RWLock
rwLock = 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 RWLock
rwLock' <- RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RWLock
rwLock
    Ptr RWLock -> IO ()
g_rw_lock_writer_lock Ptr RWLock
rwLock'
    RWLock -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RWLock
rwLock
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RWLockWriterLockMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RWLockWriterLockMethodInfo RWLock signature where
    overloadedMethod = rWLockWriterLock

instance O.OverloadedMethodInfo RWLockWriterLockMethodInfo RWLock where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.RWLock.rWLockWriterLock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-RWLock.html#v:rWLockWriterLock"
        })


#endif

-- method RWLock::writer_trylock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rw_lock"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "RWLock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRWLock" , 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 "g_rw_lock_writer_trylock" g_rw_lock_writer_trylock :: 
    Ptr RWLock ->                           -- rw_lock : TInterface (Name {namespace = "GLib", name = "RWLock"})
    IO CInt

-- | Tries to obtain a write lock on /@rwLock@/. If another thread
-- currently holds a read or write lock on /@rwLock@/, it immediately
-- returns 'P.False'.
-- Otherwise it locks /@rwLock@/ and returns 'P.True'.
-- 
-- /Since: 2.32/
rWLockWriterTrylock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RWLock
    -- ^ /@rwLock@/: a t'GI.GLib.Structs.RWLock.RWLock'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@rwLock@/ could be locked
rWLockWriterTrylock :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RWLock -> m Bool
rWLockWriterTrylock RWLock
rwLock = IO Bool -> m Bool
forall a. IO a -> m a
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 RWLock
rwLock' <- RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RWLock
rwLock
    CInt
result <- Ptr RWLock -> IO CInt
g_rw_lock_writer_trylock Ptr RWLock
rwLock'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RWLock -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RWLock
rwLock
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RWLockWriterTrylockMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod RWLockWriterTrylockMethodInfo RWLock signature where
    overloadedMethod = rWLockWriterTrylock

instance O.OverloadedMethodInfo RWLockWriterTrylockMethodInfo RWLock where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.RWLock.rWLockWriterTrylock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-RWLock.html#v:rWLockWriterTrylock"
        })


#endif

-- method RWLock::writer_unlock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rw_lock"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "RWLock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRWLock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_rw_lock_writer_unlock" g_rw_lock_writer_unlock :: 
    Ptr RWLock ->                           -- rw_lock : TInterface (Name {namespace = "GLib", name = "RWLock"})
    IO ()

-- | Release a write lock on /@rwLock@/.
-- 
-- Calling 'GI.GLib.Structs.RWLock.rWLockWriterUnlock' on a lock that is not held
-- by the current thread leads to undefined behaviour.
-- 
-- /Since: 2.32/
rWLockWriterUnlock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RWLock
    -- ^ /@rwLock@/: a t'GI.GLib.Structs.RWLock.RWLock'
    -> m ()
rWLockWriterUnlock :: forall (m :: * -> *). (HasCallStack, MonadIO m) => RWLock -> m ()
rWLockWriterUnlock RWLock
rwLock = 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 RWLock
rwLock' <- RWLock -> IO (Ptr RWLock)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RWLock
rwLock
    Ptr RWLock -> IO ()
g_rw_lock_writer_unlock Ptr RWLock
rwLock'
    RWLock -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RWLock
rwLock
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RWLockWriterUnlockMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RWLockWriterUnlockMethodInfo RWLock signature where
    overloadedMethod = rWLockWriterUnlock

instance O.OverloadedMethodInfo RWLockWriterUnlockMethodInfo RWLock where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.RWLock.rWLockWriterUnlock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.29/docs/GI-GLib-Structs-RWLock.html#v:rWLockWriterUnlock"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRWLockMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveRWLockMethod "clear" o = RWLockClearMethodInfo
    ResolveRWLockMethod "init" o = RWLockInitMethodInfo
    ResolveRWLockMethod "readerLock" o = RWLockReaderLockMethodInfo
    ResolveRWLockMethod "readerTrylock" o = RWLockReaderTrylockMethodInfo
    ResolveRWLockMethod "readerUnlock" o = RWLockReaderUnlockMethodInfo
    ResolveRWLockMethod "writerLock" o = RWLockWriterLockMethodInfo
    ResolveRWLockMethod "writerTrylock" o = RWLockWriterTrylockMethodInfo
    ResolveRWLockMethod "writerUnlock" o = RWLockWriterUnlockMethodInfo
    ResolveRWLockMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif