{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Internal to the arbiter packages. Not covered by the PVP.
--
-- RTS thread labels for an eventlog, ThreadScope session or @ghc-debug@ dump, and the
-- time units of the timeout and delay primitives.
module Arbiter.Core.Threads
  ( labelArbiterThread
  , microsPerSecond
  , millisPerSecond
  , micros
  ) where

import Control.Concurrent (myThreadId)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Foldable (toList)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (NominalDiffTime)
import GHC.Conc.Sync (labelThread)

-- | Label the calling thread @arbiter:role[:queue]@. Only the role is slugged. For
-- long-lived threads only.
labelArbiterThread :: (MonadIO m) => Text -> Maybe Text -> m ()
labelArbiterThread :: forall (m :: * -> *). MonadIO m => Text -> Maybe Text -> m ()
labelArbiterThread Text
role Maybe Text
mQueue = 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
  tid <- IO ThreadId
myThreadId
  labelThread tid (T.unpack (T.intercalate ":" ("arbiter" : slug role : toList mQueue)))
  where
    slug :: Text -> Text
slug = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"-" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower

-- | Microseconds in one second.
microsPerSecond :: (Num a) => a
microsPerSecond :: forall a. Num a => a
microsPerSecond = a
1_000_000

-- | Milliseconds in one second.
millisPerSecond :: (Num a) => a
millisPerSecond :: forall a. Num a => a
millisPerSecond = a
1000

-- | An interval in microseconds, for the timeout and delay primitives.
micros :: NominalDiffTime -> Int
micros :: NominalDiffTime -> Int
micros NominalDiffTime
seconds = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
seconds Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Num a => a
microsPerSecond :: Double)