SizedChan.hs

-- | Chan with size
module Control.Concurrent.SizedChan (SizedChan, newSizedChan, writeSizedChan, readSizedChan, tryReadSizedChan, peekSizedChan, tryPeekSizedChan, isEmptySizedChan) where

import Control.Concurrent.Chan
import Data.IORef

data SizedChan a = 
  SizedChan 
    (Chan a) -- ^ The channel
    (IORef Int) -- ^ Its size
    (IORef (Maybe a)) -- ^ Peeked payload

-- | Build and returns a new instance of 'SizedChan'.
newSizedChan :: IO (SizedChan a)
newSizedChan =
  SizedChan
    <$> newChan
    <*> newIORef 0
    <*> newIORef Nothing

-- | Write a value to a 'SizedChan'.
writeSizedChan :: SizedChan a -> a -> IO ()
writeSizedChan (SizedChan chan sizeIORef _) val = do
  writeChan chan val
  modifyIORef' sizeIORef succ

-- | Read the next value from the 'SizedChan'. Blocks when the channel is empty.
readSizedChan :: SizedChan a -> IO a
readSizedChan (SizedChan chan sizeIORef peekedIORef) = do
  peeked <- readIORef peekedIORef
  case peeked of
    -- return and remove the peeked value
    Just val -> do
      writeIORef peekedIORef Nothing
      modifyIORef' sizeIORef pred
      return val
    -- else read from the channel
    Nothing -> do
      val <- readChan chan
      modifyIORef' sizeIORef pred
      return val

-- | A version of `readSizedChan` which does not block. Instead it returns Nothing if no value is available.
tryReadSizedChan :: SizedChan a -> IO (Maybe a)
tryReadSizedChan (SizedChan chan sizeIORef peekedIORef) = do
  peeked <- readIORef peekedIORef
  case peeked of
    -- return and remove the peeked value
    Just val -> do
      writeIORef peekedIORef Nothing
      modifyIORef' sizeIORef pred
      return $ Just val
    -- check the size before reading from the channel, to prevent blocking
    Nothing -> do
      size <- readIORef sizeIORef
      if size == 0
        then return Nothing
        else do
          val <- readChan chan
          modifyIORef' sizeIORef pred
          return $ Just val

-- | Peek the next value from the 'SizedChan' without removing it. Blocks when the channel is empty.
peekSizedChan :: SizedChan a -> IO a
peekSizedChan (SizedChan chan _ peekedIORef) = do
  peeked <- readIORef peekedIORef
  case peeked of
    -- return the peeked value
    Just val -> return val
    -- read from the channel instead
    Nothing -> do 
      val <- readChan chan
      writeIORef peekedIORef (Just val)
      return val

-- | A version of `peekSizedChan` which does not block. Instead it returns Nothing if no value is available.
tryPeekSizedChan :: SizedChan a -> IO (Maybe a)
tryPeekSizedChan (SizedChan chan sizeIORef peekedIORef) = do 
  peeked <- readIORef peekedIORef
  case peeked of
    -- return the peeked value
    Just val -> return $ Just val
    -- check the size before reading from the channel, to prevent blocking
    Nothing -> do
      size <- readIORef sizeIORef
      if size == 0
        then return Nothing
        else do
          val <- readChan chan
          writeIORef peekedIORef (Just val)
          return $ Just val

measureSizedChan :: SizedChan a -> IO Int
measureSizedChan (SizedChan _ sizeIORef _) = readIORef sizeIORef

isEmptySizedChan :: SizedChan a -> IO Bool
isEmptySizedChan chan = do
  size <- measureSizedChan chan
  return $ size == 0