module Brick.BChan
  ( BChan
  , newBChan
  , writeBChan
  , writeBChanNonBlocking
  , readBChan
  , readBChan2
  )
where

import Control.Concurrent.STM.TBQueue
import Control.Monad.STM (atomically, orElse)

-- | @BChan@ is an abstract type representing a bounded FIFO channel.
data BChan a = BChan (TBQueue a)

-- | Builds and returns a new instance of @BChan@.
newBChan :: Int   -- ^ maximum number of elements the channel can hold
          -> IO (BChan a)
newBChan :: forall a. Int -> IO (BChan a)
newBChan Int
size = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TBQueue a -> BChan a
BChan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Natural -> STM (TBQueue a)
newTBQueue (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)

-- | Writes a value to a @BChan@; blocks if the channel is full.
writeBChan :: BChan a -> a -> IO ()
writeBChan :: forall a. BChan a -> a -> IO ()
writeBChan (BChan TBQueue a
q) a
a = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue a
q a
a

-- | Attempts to write a value to a @BChan@. If the channel has room,
-- the value is written and this returns 'True'. Otherwise this returns
-- 'False' and returns immediately.
writeBChanNonBlocking :: BChan a -> a -> IO Bool
writeBChanNonBlocking :: forall a. BChan a -> a -> IO Bool
writeBChanNonBlocking (BChan TBQueue a
q) a
a = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
    Bool
f <- forall a. TBQueue a -> STM Bool
isFullTBQueue TBQueue a
q
    if Bool
f
       then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
       else forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue a
q a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Reads the next value from the @BChan@; blocks if necessary.
readBChan :: BChan a -> IO a
readBChan :: forall a. BChan a -> IO a
readBChan (BChan TBQueue a
q) = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TBQueue a -> STM a
readTBQueue TBQueue a
q

-- | Reads the next value from either @BChan@, prioritizing the first
-- @BChan@; blocks if necessary.
readBChan2 :: BChan a -> BChan b -> IO (Either a b)
readBChan2 :: forall a b. BChan a -> BChan b -> IO (Either a b)
readBChan2 (BChan TBQueue a
q1) (BChan TBQueue b
q2) = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$
  (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TBQueue a -> STM a
readTBQueue TBQueue a
q1) forall a. STM a -> STM a -> STM a
`orElse` (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TBQueue a -> STM a
readTBQueue TBQueue b
q2)