module Ki.Internal.ThreadOptions
  ( ThreadOptions (..),
    defaultThreadOptions,
  )
where

import Control.Exception (MaskingState (..))
import Ki.Internal.ByteCount (ByteCount)
import Ki.Internal.ThreadAffinity (ThreadAffinity (..))

-- |
--
-- [@affinity@]:
--
--     The affinity of a thread. A thread can be unbound, bound to a specific capability, or bound to a specific OS
--     thread.
--
--     Default: 'Unbound'
--
-- [@allocationLimit@]:
--
--     The maximum number of bytes a thread may allocate before it is delivered an
--     'Control.Exception.AllocationLimitExceeded' exception. If caught, the thread is allowed to allocate an additional
--     100kb (tunable with @+RTS -xq@) to perform any necessary cleanup actions; if exceeded, the thread is delivered
--     another.
--
--     Default: @Nothing@ (no limit)
--
-- [@label@]:
--
--     The label of a thread, visible in the [event log](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/runtime_control.html#rts-eventlog) (@+RTS -l@).
--
--     Default: @""@ (no label)
--
-- [@maskingState@]:
--
--     The masking state a thread is created in. To unmask, use 'GHC.IO.unsafeUnmask'.
--
--     Default: @Unmasked@
data ThreadOptions = ThreadOptions
  { ThreadOptions -> ThreadAffinity
affinity :: ThreadAffinity,
    ThreadOptions -> Maybe ByteCount
allocationLimit :: Maybe ByteCount,
    ThreadOptions -> String
label :: String,
    ThreadOptions -> MaskingState
maskingState :: MaskingState
  }
  deriving stock (ThreadOptions -> ThreadOptions -> Bool
(ThreadOptions -> ThreadOptions -> Bool)
-> (ThreadOptions -> ThreadOptions -> Bool) -> Eq ThreadOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ThreadOptions -> ThreadOptions -> Bool
== :: ThreadOptions -> ThreadOptions -> Bool
$c/= :: ThreadOptions -> ThreadOptions -> Bool
/= :: ThreadOptions -> ThreadOptions -> Bool
Eq, Int -> ThreadOptions -> ShowS
[ThreadOptions] -> ShowS
ThreadOptions -> String
(Int -> ThreadOptions -> ShowS)
-> (ThreadOptions -> String)
-> ([ThreadOptions] -> ShowS)
-> Show ThreadOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ThreadOptions -> ShowS
showsPrec :: Int -> ThreadOptions -> ShowS
$cshow :: ThreadOptions -> String
show :: ThreadOptions -> String
$cshowList :: [ThreadOptions] -> ShowS
showList :: [ThreadOptions] -> ShowS
Show)

-- | Default thread options.
--
-- @
-- 'Ki.ThreadOptions'
--   { 'Ki.affinity' = 'Ki.Unbound'
--   , 'Ki.allocationLimit' = Nothing
--   , 'Ki.label' = ""
--   , 'Ki.maskingState' = 'Unmasked'
--   }
-- @
defaultThreadOptions :: ThreadOptions
defaultThreadOptions :: ThreadOptions
defaultThreadOptions =
  ThreadOptions
    { $sel:affinity:ThreadOptions :: ThreadAffinity
affinity = ThreadAffinity
Unbound,
      $sel:allocationLimit:ThreadOptions :: Maybe ByteCount
allocationLimit = Maybe ByteCount
forall a. Maybe a
Nothing,
      $sel:label:ThreadOptions :: String
label = String
"",
      $sel:maskingState:ThreadOptions :: MaskingState
maskingState = MaskingState
Unmasked
    }