{-# LANGUAGE CPP #-}

{- |
Copyright:  (c) 2018-2020 Kowainik, (c) 2020 Alexander Vershilov
SPDX-License-Identifier: MPL-2.0
Maintainer: Alexander Vershilov <alexander.vershilov@gmail.com>

This is internal module, use it on your own risk. The implementation here may be
changed without a version bump.
-}

module Colog.Concurrent.Internal
       ( BackgroundWorker (..)
       , Capacity (..)
       , mkCapacity
       ) where

import Control.Concurrent (ThreadId)
import Control.Concurrent.STM (STM, TVar)
import Numeric.Natural (Natural)


{- | A wrapper type that carries capacity. The internal type may be
differrent for the different GHC versions.
-}
#if MIN_VERSION_stm(2,5,0)
data Capacity = Capacity Natural (Maybe Natural)
  deriving stock Int -> Capacity -> ShowS
[Capacity] -> ShowS
Capacity -> String
(Int -> Capacity -> ShowS)
-> (Capacity -> String) -> ([Capacity] -> ShowS) -> Show Capacity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Capacity] -> ShowS
$cshowList :: [Capacity] -> ShowS
show :: Capacity -> String
$cshow :: Capacity -> String
showsPrec :: Int -> Capacity -> ShowS
$cshowsPrec :: Int -> Capacity -> ShowS
Show
#else
data Capacity = Capacity Int (Maybe Natural)
  deriving stock Show
#endif

-- | Creates new capacity.
--
-- @since 0.5.0.0
mkCapacity
  :: Natural -- ^ Size of the queue. Number of the messages in flight
  -> Maybe Natural -- ^ Maximum number of messages that logger can read in a chunk.
  -> Capacity
mkCapacity :: Natural -> Maybe Natural -> Capacity
mkCapacity Natural
n = Natural -> Maybe Natural -> Capacity
Capacity (Natural -> Natural
forall a. a -> a
mk Natural
n)  where
#if MIN_VERSION_stm(2,5,0)
  mk :: a -> a
mk = a -> a
forall a. a -> a
id
#else
  mk = fromIntegral
#endif

{- | Wrapper for the background thread that may receive messages to
process.
-}
data BackgroundWorker msg = BackgroundWorker
    { BackgroundWorker msg -> ThreadId
backgroundWorkerThreadId :: !ThreadId
      -- ^ Background 'ThreadId'.
    , BackgroundWorker msg -> msg -> STM ()
backgroundWorkerWrite    :: msg -> STM ()
      -- ^ Method for communication with the thread.
    , BackgroundWorker msg -> TVar Bool
backgroundWorkerIsAlive  :: TVar Bool
    }