{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module: Internal.TCloseQ
-- Description: Transactional queues with a close operation.
--
-- This module provides a thin layer over 'TQueue', which affords "closing"
-- queues. Reading from a closed queue returns 'Nothing'.
module Internal.TCloseQ
  ( Q,
    ErrClosed (..),
    new,
    read,
    write,
    close,
  )
where

import Control.Concurrent.STM
import Control.Exception (Exception)
import Control.Monad (unless, when)
import Data.Maybe (isNothing)
import Prelude hiding (read)

-- | A Queue with a close operation, with element type @a@.
data Q a = Q
  { forall a. Q a -> TQueue (Maybe a)
q :: TQueue (Maybe a),
    forall a. Q a -> TVar Bool
isClosed :: TVar Bool
  }

-- | An exception which is thrown if a caller tries to write to a closed queue.
data ErrClosed = ErrClosed
  deriving (Int -> ErrClosed -> ShowS
[ErrClosed] -> ShowS
ErrClosed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrClosed] -> ShowS
$cshowList :: [ErrClosed] -> ShowS
show :: ErrClosed -> String
$cshow :: ErrClosed -> String
showsPrec :: Int -> ErrClosed -> ShowS
$cshowsPrec :: Int -> ErrClosed -> ShowS
Show)

instance Exception ErrClosed

-- | Create a new empty queue.
new :: STM (Q a)
new :: forall a. STM (Q a)
new = do
  TQueue (Maybe a)
q <- forall a. STM (TQueue a)
newTQueue
  TVar Bool
isClosed <- forall a. a -> STM (TVar a)
newTVar Bool
False
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Q {TVar Bool
TQueue (Maybe a)
isClosed :: TVar Bool
q :: TQueue (Maybe a)
isClosed :: TVar Bool
q :: TQueue (Maybe a)
..}

-- | Read a value from the queue. Returns Nothing if the queue is closed.
read :: Q a -> STM (Maybe a)
read :: forall a. Q a -> STM (Maybe a)
read Q {TQueue (Maybe a)
q :: TQueue (Maybe a)
q :: forall a. Q a -> TQueue (Maybe a)
q} = do
  Maybe a
ret <- forall a. TQueue a -> STM a
readTQueue TQueue (Maybe a)
q
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe a
ret) forall a b. (a -> b) -> a -> b
$
    -- put it back in, so future reads also return nothing:
    forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Maybe a)
q Maybe a
ret
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
ret

-- | Write a value to the queue, which must not be closed. If it is closed,
-- this will throw 'ErrClosed'.
write :: Q a -> a -> STM ()
write :: forall a. Q a -> a -> STM ()
write Q {TQueue (Maybe a)
q :: TQueue (Maybe a)
q :: forall a. Q a -> TQueue (Maybe a)
q, TVar Bool
isClosed :: TVar Bool
isClosed :: forall a. Q a -> TVar Bool
isClosed} a
v = do
  Bool
c <- forall a. TVar a -> STM a
readTVar TVar Bool
isClosed
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> STM a
throwSTM ErrClosed
ErrClosed
  forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Maybe a)
q (forall a. a -> Maybe a
Just a
v)

-- | Close a queue. It is safe to close a queue more than once; subsequent
-- closes will have no effect.
close :: Q a -> STM ()
close :: forall a. Q a -> STM ()
close Q {TQueue (Maybe a)
q :: TQueue (Maybe a)
q :: forall a. Q a -> TQueue (Maybe a)
q, TVar Bool
isClosed :: TVar Bool
isClosed :: forall a. Q a -> TVar Bool
isClosed} = do
  Bool
c <- forall a. TVar a -> STM a
readTVar TVar Bool
isClosed
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
c forall a b. (a -> b) -> a -> b
$ do
    forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
isClosed Bool
True
    forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Maybe a)
q forall a. Maybe a
Nothing