{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.GLib.Structs.ThreadPool
(
ThreadPool(..) ,
newZeroThreadPool ,
#if defined(ENABLE_OVERLOADING)
ResolveThreadPoolMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
ThreadPoolFreeMethodInfo ,
#endif
threadPoolFree ,
threadPoolGetMaxIdleTime ,
#if defined(ENABLE_OVERLOADING)
ThreadPoolGetMaxThreadsMethodInfo ,
#endif
threadPoolGetMaxThreads ,
threadPoolGetMaxUnusedThreads ,
#if defined(ENABLE_OVERLOADING)
ThreadPoolGetNumThreadsMethodInfo ,
#endif
threadPoolGetNumThreads ,
threadPoolGetNumUnusedThreads ,
#if defined(ENABLE_OVERLOADING)
ThreadPoolMoveToFrontMethodInfo ,
#endif
threadPoolMoveToFront ,
#if defined(ENABLE_OVERLOADING)
ThreadPoolPushMethodInfo ,
#endif
threadPoolPush ,
threadPoolSetMaxIdleTime ,
#if defined(ENABLE_OVERLOADING)
ThreadPoolSetMaxThreadsMethodInfo ,
#endif
threadPoolSetMaxThreads ,
threadPoolSetMaxUnusedThreads ,
threadPoolStopUnusedThreads ,
#if defined(ENABLE_OVERLOADING)
ThreadPoolUnprocessedMethodInfo ,
#endif
threadPoolUnprocessed ,
getThreadPoolExclusive ,
setThreadPoolExclusive ,
#if defined(ENABLE_OVERLOADING)
threadPool_exclusive ,
#endif
clearThreadPoolFunc ,
getThreadPoolFunc ,
setThreadPoolFunc ,
#if defined(ENABLE_OVERLOADING)
threadPool_func ,
#endif
clearThreadPoolUserData ,
getThreadPoolUserData ,
setThreadPoolUserData ,
#if defined(ENABLE_OVERLOADING)
threadPool_userData ,
#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.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.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified GI.GLib.Callbacks as GLib.Callbacks
newtype ThreadPool = ThreadPool (SP.ManagedPtr ThreadPool)
deriving (ThreadPool -> ThreadPool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadPool -> ThreadPool -> Bool
$c/= :: ThreadPool -> ThreadPool -> Bool
== :: ThreadPool -> ThreadPool -> Bool
$c== :: ThreadPool -> ThreadPool -> Bool
Eq)
instance SP.ManagedPtrNewtype ThreadPool where
toManagedPtr :: ThreadPool -> ManagedPtr ThreadPool
toManagedPtr (ThreadPool ManagedPtr ThreadPool
p) = ManagedPtr ThreadPool
p
instance BoxedPtr ThreadPool where
boxedPtrCopy :: ThreadPool -> IO ThreadPool
boxedPtrCopy = \ThreadPool
p -> forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ThreadPool
p (forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
12 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr ThreadPool -> ThreadPool
ThreadPool)
boxedPtrFree :: ThreadPool -> IO ()
boxedPtrFree = \ThreadPool
x -> forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr ThreadPool
x forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr ThreadPool where
boxedPtrCalloc :: IO (Ptr ThreadPool)
boxedPtrCalloc = forall a. Int -> IO (Ptr a)
callocBytes Int
12
newZeroThreadPool :: MonadIO m => m ThreadPool
newZeroThreadPool :: forall (m :: * -> *). MonadIO m => m ThreadPool
newZeroThreadPool = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ThreadPool -> ThreadPool
ThreadPool
instance tag ~ 'AttrSet => Constructible ThreadPool tag where
new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ThreadPool -> ThreadPool)
-> [AttrOp ThreadPool tag] -> m ThreadPool
new ManagedPtr ThreadPool -> ThreadPool
_ [AttrOp ThreadPool tag]
attrs = do
ThreadPool
o <- forall (m :: * -> *). MonadIO m => m ThreadPool
newZeroThreadPool
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ThreadPool
o [AttrOp ThreadPool tag]
attrs
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadPool
o
getThreadPoolFunc :: MonadIO m => ThreadPool -> m (Maybe GLib.Callbacks.Func_WithClosures)
getThreadPoolFunc :: forall (m :: * -> *).
MonadIO m =>
ThreadPool -> m (Maybe Func_WithClosures)
getThreadPoolFunc ThreadPool
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ThreadPool
s forall a b. (a -> b) -> a -> b
$ \Ptr ThreadPool
ptr -> do
FunPtr Func_WithClosures
val <- forall a. Storable a => Ptr a -> IO a
peek (Ptr ThreadPool
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (FunPtr GLib.Callbacks.C_Func)
Maybe Func_WithClosures
result <- forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr Func_WithClosures
val forall a b. (a -> b) -> a -> b
$ \FunPtr Func_WithClosures
val' -> do
let val'' :: Func_WithClosures
val'' = forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr Func_WithClosures -> Ptr () -> Ptr () -> m ()
GLib.Callbacks.dynamic_Func FunPtr Func_WithClosures
val'
forall (m :: * -> *) a. Monad m => a -> m a
return Func_WithClosures
val''
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Func_WithClosures
result
setThreadPoolFunc :: MonadIO m => ThreadPool -> FunPtr GLib.Callbacks.C_Func -> m ()
setThreadPoolFunc :: forall (m :: * -> *).
MonadIO m =>
ThreadPool -> FunPtr Func_WithClosures -> m ()
setThreadPoolFunc ThreadPool
s FunPtr Func_WithClosures
val = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ThreadPool
s forall a b. (a -> b) -> a -> b
$ \Ptr ThreadPool
ptr -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ThreadPool
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (FunPtr Func_WithClosures
val :: FunPtr GLib.Callbacks.C_Func)
clearThreadPoolFunc :: MonadIO m => ThreadPool -> m ()
clearThreadPoolFunc :: forall (m :: * -> *). MonadIO m => ThreadPool -> m ()
clearThreadPoolFunc ThreadPool
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ThreadPool
s forall a b. (a -> b) -> a -> b
$ \Ptr ThreadPool
ptr -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ThreadPool
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (forall a. FunPtr a
FP.nullFunPtr :: FunPtr GLib.Callbacks.C_Func)
#if defined(ENABLE_OVERLOADING)
data ThreadPoolFuncFieldInfo
instance AttrInfo ThreadPoolFuncFieldInfo where
type AttrBaseTypeConstraint ThreadPoolFuncFieldInfo = (~) ThreadPool
type AttrAllowedOps ThreadPoolFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint ThreadPoolFuncFieldInfo = (~) (FunPtr GLib.Callbacks.C_Func)
type AttrTransferTypeConstraint ThreadPoolFuncFieldInfo = (~)GLib.Callbacks.Func_WithClosures
type AttrTransferType ThreadPoolFuncFieldInfo = (FunPtr GLib.Callbacks.C_Func)
type AttrGetType ThreadPoolFuncFieldInfo = Maybe GLib.Callbacks.Func_WithClosures
type AttrLabel ThreadPoolFuncFieldInfo = "func"
type AttrOrigin ThreadPoolFuncFieldInfo = ThreadPool
attrGet = getThreadPoolFunc
attrSet = setThreadPoolFunc
attrConstruct = undefined
attrClear = clearThreadPoolFunc
attrTransfer _ v = do
GLib.Callbacks.mk_Func (GLib.Callbacks.wrap_Func Nothing v)
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.func"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#g:attr:func"
})
threadPool_func :: AttrLabelProxy "func"
threadPool_func = AttrLabelProxy
#endif
getThreadPoolUserData :: MonadIO m => ThreadPool -> m (Ptr ())
getThreadPoolUserData :: forall (m :: * -> *). MonadIO m => ThreadPool -> m (Ptr ())
getThreadPoolUserData ThreadPool
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ThreadPool
s forall a b. (a -> b) -> a -> b
$ \Ptr ThreadPool
ptr -> do
Ptr ()
val <- forall a. Storable a => Ptr a -> IO a
peek (Ptr ThreadPool
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) :: IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
val
setThreadPoolUserData :: MonadIO m => ThreadPool -> Ptr () -> m ()
setThreadPoolUserData :: forall (m :: * -> *). MonadIO m => ThreadPool -> Ptr () -> m ()
setThreadPoolUserData ThreadPool
s Ptr ()
val = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ThreadPool
s forall a b. (a -> b) -> a -> b
$ \Ptr ThreadPool
ptr -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ThreadPool
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Ptr ()
val :: Ptr ())
clearThreadPoolUserData :: MonadIO m => ThreadPool -> m ()
clearThreadPoolUserData :: forall (m :: * -> *). MonadIO m => ThreadPool -> m ()
clearThreadPoolUserData ThreadPool
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ThreadPool
s forall a b. (a -> b) -> a -> b
$ \Ptr ThreadPool
ptr -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ThreadPool
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (forall a. Ptr a
FP.nullPtr :: Ptr ())
#if defined(ENABLE_OVERLOADING)
data ThreadPoolUserDataFieldInfo
instance AttrInfo ThreadPoolUserDataFieldInfo where
type AttrBaseTypeConstraint ThreadPoolUserDataFieldInfo = (~) ThreadPool
type AttrAllowedOps ThreadPoolUserDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint ThreadPoolUserDataFieldInfo = (~) (Ptr ())
type AttrTransferTypeConstraint ThreadPoolUserDataFieldInfo = (~)(Ptr ())
type AttrTransferType ThreadPoolUserDataFieldInfo = (Ptr ())
type AttrGetType ThreadPoolUserDataFieldInfo = Ptr ()
type AttrLabel ThreadPoolUserDataFieldInfo = "user_data"
type AttrOrigin ThreadPoolUserDataFieldInfo = ThreadPool
attrGet = getThreadPoolUserData
attrSet = setThreadPoolUserData
attrConstruct = undefined
attrClear = clearThreadPoolUserData
attrTransfer _ v = do
return v
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.userData"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#g:attr:userData"
})
threadPool_userData :: AttrLabelProxy "userData"
threadPool_userData = AttrLabelProxy
#endif
getThreadPoolExclusive :: MonadIO m => ThreadPool -> m Bool
getThreadPoolExclusive :: forall (m :: * -> *). MonadIO m => ThreadPool -> m Bool
getThreadPoolExclusive ThreadPool
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ThreadPool
s forall a b. (a -> b) -> a -> b
$ \Ptr ThreadPool
ptr -> do
CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (Ptr ThreadPool
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CInt
let val' :: Bool
val' = (forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
val
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val'
setThreadPoolExclusive :: MonadIO m => ThreadPool -> Bool -> m ()
setThreadPoolExclusive :: forall (m :: * -> *). MonadIO m => ThreadPool -> Bool -> m ()
setThreadPoolExclusive ThreadPool
s Bool
val = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ThreadPool
s forall a b. (a -> b) -> a -> b
$ \Ptr ThreadPool
ptr -> do
let val' :: CInt
val' = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Bool
val
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ThreadPool
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CInt
val' :: CInt)
#if defined(ENABLE_OVERLOADING)
data ThreadPoolExclusiveFieldInfo
instance AttrInfo ThreadPoolExclusiveFieldInfo where
type AttrBaseTypeConstraint ThreadPoolExclusiveFieldInfo = (~) ThreadPool
type AttrAllowedOps ThreadPoolExclusiveFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint ThreadPoolExclusiveFieldInfo = (~) Bool
type AttrTransferTypeConstraint ThreadPoolExclusiveFieldInfo = (~)Bool
type AttrTransferType ThreadPoolExclusiveFieldInfo = Bool
type AttrGetType ThreadPoolExclusiveFieldInfo = Bool
type AttrLabel ThreadPoolExclusiveFieldInfo = "exclusive"
type AttrOrigin ThreadPoolExclusiveFieldInfo = ThreadPool
attrGet = getThreadPoolExclusive
attrSet = setThreadPoolExclusive
attrConstruct = undefined
attrClear = undefined
attrTransfer _ v = do
return v
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.exclusive"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#g:attr:exclusive"
})
threadPool_exclusive :: AttrLabelProxy "exclusive"
threadPool_exclusive = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ThreadPool
type instance O.AttributeList ThreadPool = ThreadPoolAttributeList
type ThreadPoolAttributeList = ('[ '("func", ThreadPoolFuncFieldInfo), '("userData", ThreadPoolUserDataFieldInfo), '("exclusive", ThreadPoolExclusiveFieldInfo)] :: [(Symbol, *)])
#endif
foreign import ccall "g_thread_pool_free" g_thread_pool_free ::
Ptr ThreadPool ->
CInt ->
CInt ->
IO ()
threadPoolFree ::
(B.CallStack.HasCallStack, MonadIO m) =>
ThreadPool
-> Bool
-> Bool
-> m ()
threadPoolFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ThreadPool -> Bool -> Bool -> m ()
threadPoolFree ThreadPool
pool Bool
immediate Bool
wait_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr ThreadPool
pool' <- forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ThreadPool
pool
let immediate' :: CInt
immediate' = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Bool
immediate
let wait_' :: CInt
wait_' = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Bool
wait_
Ptr ThreadPool -> CInt -> CInt -> IO ()
g_thread_pool_free Ptr ThreadPool
pool' CInt
immediate' CInt
wait_'
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ThreadPool
pool
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ThreadPoolFreeMethodInfo
instance (signature ~ (Bool -> Bool -> m ()), MonadIO m) => O.OverloadedMethod ThreadPoolFreeMethodInfo ThreadPool signature where
overloadedMethod = threadPoolFree
instance O.OverloadedMethodInfo ThreadPoolFreeMethodInfo ThreadPool where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.threadPoolFree",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#v:threadPoolFree"
})
#endif
foreign import ccall "g_thread_pool_get_max_threads" g_thread_pool_get_max_threads ::
Ptr ThreadPool ->
IO Int32
threadPoolGetMaxThreads ::
(B.CallStack.HasCallStack, MonadIO m) =>
ThreadPool
-> m Int32
threadPoolGetMaxThreads :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ThreadPool -> m Int32
threadPoolGetMaxThreads ThreadPool
pool = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr ThreadPool
pool' <- forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ThreadPool
pool
Int32
result <- Ptr ThreadPool -> IO Int32
g_thread_pool_get_max_threads Ptr ThreadPool
pool'
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ThreadPool
pool
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data ThreadPoolGetMaxThreadsMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod ThreadPoolGetMaxThreadsMethodInfo ThreadPool signature where
overloadedMethod = threadPoolGetMaxThreads
instance O.OverloadedMethodInfo ThreadPoolGetMaxThreadsMethodInfo ThreadPool where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.threadPoolGetMaxThreads",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#v:threadPoolGetMaxThreads"
})
#endif
foreign import ccall "g_thread_pool_get_num_threads" g_thread_pool_get_num_threads ::
Ptr ThreadPool ->
IO Word32
threadPoolGetNumThreads ::
(B.CallStack.HasCallStack, MonadIO m) =>
ThreadPool
-> m Word32
threadPoolGetNumThreads :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ThreadPool -> m Word32
threadPoolGetNumThreads ThreadPool
pool = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr ThreadPool
pool' <- forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ThreadPool
pool
Word32
result <- Ptr ThreadPool -> IO Word32
g_thread_pool_get_num_threads Ptr ThreadPool
pool'
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ThreadPool
pool
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data ThreadPoolGetNumThreadsMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ThreadPoolGetNumThreadsMethodInfo ThreadPool signature where
overloadedMethod = threadPoolGetNumThreads
instance O.OverloadedMethodInfo ThreadPoolGetNumThreadsMethodInfo ThreadPool where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.threadPoolGetNumThreads",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#v:threadPoolGetNumThreads"
})
#endif
foreign import ccall "g_thread_pool_move_to_front" g_thread_pool_move_to_front ::
Ptr ThreadPool ->
Ptr () ->
IO CInt
threadPoolMoveToFront ::
(B.CallStack.HasCallStack, MonadIO m) =>
ThreadPool
-> Ptr ()
-> m Bool
threadPoolMoveToFront :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ThreadPool -> Ptr () -> m Bool
threadPoolMoveToFront ThreadPool
pool Ptr ()
data_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr ThreadPool
pool' <- forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ThreadPool
pool
CInt
result <- Ptr ThreadPool -> Ptr () -> IO CInt
g_thread_pool_move_to_front Ptr ThreadPool
pool' Ptr ()
data_
let result' :: Bool
result' = (forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ThreadPool
pool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data ThreadPoolMoveToFrontMethodInfo
instance (signature ~ (Ptr () -> m Bool), MonadIO m) => O.OverloadedMethod ThreadPoolMoveToFrontMethodInfo ThreadPool signature where
overloadedMethod = threadPoolMoveToFront
instance O.OverloadedMethodInfo ThreadPoolMoveToFrontMethodInfo ThreadPool where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.threadPoolMoveToFront",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#v:threadPoolMoveToFront"
})
#endif
foreign import ccall "g_thread_pool_push" g_thread_pool_push ::
Ptr ThreadPool ->
Ptr () ->
Ptr (Ptr GError) ->
IO CInt
threadPoolPush ::
(B.CallStack.HasCallStack, MonadIO m) =>
ThreadPool
-> Ptr ()
-> m ()
threadPoolPush :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ThreadPool -> Ptr () -> m ()
threadPoolPush ThreadPool
pool Ptr ()
data_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr ThreadPool
pool' <- forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ThreadPool
pool
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError forall a b. (a -> b) -> a -> b
$ Ptr ThreadPool -> Ptr () -> Ptr (Ptr GError) -> IO CInt
g_thread_pool_push Ptr ThreadPool
pool' Ptr ()
data_
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ThreadPool
pool
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data ThreadPoolPushMethodInfo
instance (signature ~ (Ptr () -> m ()), MonadIO m) => O.OverloadedMethod ThreadPoolPushMethodInfo ThreadPool signature where
overloadedMethod = threadPoolPush
instance O.OverloadedMethodInfo ThreadPoolPushMethodInfo ThreadPool where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.threadPoolPush",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#v:threadPoolPush"
})
#endif
foreign import ccall "g_thread_pool_set_max_threads" g_thread_pool_set_max_threads ::
Ptr ThreadPool ->
Int32 ->
Ptr (Ptr GError) ->
IO CInt
threadPoolSetMaxThreads ::
(B.CallStack.HasCallStack, MonadIO m) =>
ThreadPool
-> Int32
-> m ()
threadPoolSetMaxThreads :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ThreadPool -> Int32 -> m ()
threadPoolSetMaxThreads ThreadPool
pool Int32
maxThreads = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr ThreadPool
pool' <- forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ThreadPool
pool
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError forall a b. (a -> b) -> a -> b
$ Ptr ThreadPool -> Int32 -> Ptr (Ptr GError) -> IO CInt
g_thread_pool_set_max_threads Ptr ThreadPool
pool' Int32
maxThreads
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ThreadPool
pool
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data ThreadPoolSetMaxThreadsMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.OverloadedMethod ThreadPoolSetMaxThreadsMethodInfo ThreadPool signature where
overloadedMethod = threadPoolSetMaxThreads
instance O.OverloadedMethodInfo ThreadPoolSetMaxThreadsMethodInfo ThreadPool where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.threadPoolSetMaxThreads",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#v:threadPoolSetMaxThreads"
})
#endif
foreign import ccall "g_thread_pool_unprocessed" g_thread_pool_unprocessed ::
Ptr ThreadPool ->
IO Word32
threadPoolUnprocessed ::
(B.CallStack.HasCallStack, MonadIO m) =>
ThreadPool
-> m Word32
threadPoolUnprocessed :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ThreadPool -> m Word32
threadPoolUnprocessed ThreadPool
pool = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr ThreadPool
pool' <- forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ThreadPool
pool
Word32
result <- Ptr ThreadPool -> IO Word32
g_thread_pool_unprocessed Ptr ThreadPool
pool'
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ThreadPool
pool
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data ThreadPoolUnprocessedMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ThreadPoolUnprocessedMethodInfo ThreadPool signature where
overloadedMethod = threadPoolUnprocessed
instance O.OverloadedMethodInfo ThreadPoolUnprocessedMethodInfo ThreadPool where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.ThreadPool.threadPoolUnprocessed",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.27/docs/GI-GLib-Structs-ThreadPool.html#v:threadPoolUnprocessed"
})
#endif
foreign import ccall "g_thread_pool_get_max_idle_time" g_thread_pool_get_max_idle_time ::
IO Word32
threadPoolGetMaxIdleTime ::
(B.CallStack.HasCallStack, MonadIO m) =>
m Word32
threadPoolGetMaxIdleTime :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
threadPoolGetMaxIdleTime = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Word32
result <- IO Word32
g_thread_pool_get_max_idle_time
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_thread_pool_get_max_unused_threads" g_thread_pool_get_max_unused_threads ::
IO Int32
threadPoolGetMaxUnusedThreads ::
(B.CallStack.HasCallStack, MonadIO m) =>
m Int32
threadPoolGetMaxUnusedThreads :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Int32
threadPoolGetMaxUnusedThreads = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Int32
result <- IO Int32
g_thread_pool_get_max_unused_threads
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_thread_pool_get_num_unused_threads" g_thread_pool_get_num_unused_threads ::
IO Word32
threadPoolGetNumUnusedThreads ::
(B.CallStack.HasCallStack, MonadIO m) =>
m Word32
threadPoolGetNumUnusedThreads :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
threadPoolGetNumUnusedThreads = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Word32
result <- IO Word32
g_thread_pool_get_num_unused_threads
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_thread_pool_set_max_idle_time" g_thread_pool_set_max_idle_time ::
Word32 ->
IO ()
threadPoolSetMaxIdleTime ::
(B.CallStack.HasCallStack, MonadIO m) =>
Word32
-> m ()
threadPoolSetMaxIdleTime :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Word32 -> m ()
threadPoolSetMaxIdleTime Word32
interval = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Word32 -> IO ()
g_thread_pool_set_max_idle_time Word32
interval
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_thread_pool_set_max_unused_threads" g_thread_pool_set_max_unused_threads ::
Int32 ->
IO ()
threadPoolSetMaxUnusedThreads ::
(B.CallStack.HasCallStack, MonadIO m) =>
Int32
-> m ()
threadPoolSetMaxUnusedThreads :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Int32 -> m ()
threadPoolSetMaxUnusedThreads Int32
maxThreads = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Int32 -> IO ()
g_thread_pool_set_max_unused_threads Int32
maxThreads
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_thread_pool_stop_unused_threads" g_thread_pool_stop_unused_threads ::
IO ()
threadPoolStopUnusedThreads ::
(B.CallStack.HasCallStack, MonadIO m) =>
m ()
threadPoolStopUnusedThreads :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
threadPoolStopUnusedThreads = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
IO ()
g_thread_pool_stop_unused_threads
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
#endif
#if defined(ENABLE_OVERLOADING)
type family ResolveThreadPoolMethod (t :: Symbol) (o :: *) :: * where
ResolveThreadPoolMethod "free" o = ThreadPoolFreeMethodInfo
ResolveThreadPoolMethod "moveToFront" o = ThreadPoolMoveToFrontMethodInfo
ResolveThreadPoolMethod "push" o = ThreadPoolPushMethodInfo
ResolveThreadPoolMethod "unprocessed" o = ThreadPoolUnprocessedMethodInfo
ResolveThreadPoolMethod "getMaxThreads" o = ThreadPoolGetMaxThreadsMethodInfo
ResolveThreadPoolMethod "getNumThreads" o = ThreadPoolGetNumThreadsMethodInfo
ResolveThreadPoolMethod "setMaxThreads" o = ThreadPoolSetMaxThreadsMethodInfo
ResolveThreadPoolMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveThreadPoolMethod t ThreadPool, O.OverloadedMethod info ThreadPool p) => OL.IsLabel t (ThreadPool -> 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 ~ ResolveThreadPoolMethod t ThreadPool, O.OverloadedMethod info ThreadPool p, R.HasField t ThreadPool p) => R.HasField t ThreadPool p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveThreadPoolMethod t ThreadPool, O.OverloadedMethodInfo info ThreadPool) => OL.IsLabel t (O.MethodProxy info ThreadPool) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif