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 = STM (BChan a) -> IO (BChan a)
forall a. STM a -> IO a
atomically (STM (BChan a) -> IO (BChan a)) -> STM (BChan a) -> IO (BChan a)
forall a b. (a -> b) -> a -> b
$ TBQueue a -> BChan a
forall a. TBQueue a -> BChan a
BChan (TBQueue a -> BChan a) -> STM (TBQueue a) -> STM (BChan a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> STM (TBQueue a)
forall a. Natural -> STM (TBQueue a)
newTBQueue (Int -> Natural
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 = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TBQueue a -> a -> STM ()
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 = STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    Bool
f <- TBQueue a -> STM Bool
forall a. TBQueue a -> STM Bool
isFullTBQueue TBQueue a
q
    if Bool
f
       then Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
       else TBQueue a -> a -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue a
q a
a STM () -> STM Bool -> STM Bool
forall a b. STM a -> STM b -> STM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> STM Bool
forall a. a -> STM a
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) = STM a -> IO a
forall a. STM a -> IO a
atomically (STM a -> IO a) -> STM a -> IO a
forall a b. (a -> b) -> a -> b
$ TBQueue a -> STM a
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) = STM (Either a b) -> IO (Either a b)
forall a. STM a -> IO a
atomically (STM (Either a b) -> IO (Either a b))
-> STM (Either a b) -> IO (Either a b)
forall a b. (a -> b) -> a -> b
$
  (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> STM a -> STM (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TBQueue a -> STM a
forall a. TBQueue a -> STM a
readTBQueue TBQueue a
q1) STM (Either a b) -> STM (Either a b) -> STM (Either a b)
forall a. STM a -> STM a -> STM a
`orElse` (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> STM b -> STM (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TBQueue b -> STM b
forall a. TBQueue a -> STM a
readTBQueue TBQueue b
q2)