-- |
-- Module      : Control.Concurrent.Classy.Chan
-- Copyright   : (c) 2016 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : stable
-- Portability : portable
--
-- Unbounded channels.
--
-- __Deviations:__ @Chan@ as defined here does not have an @Eq@
-- instance, this is because the @MonadConc@ @MVar@ type does not have
-- an @Eq@ constraint. The deprecated @unGetChan@ and @isEmptyCHan@
-- functions are not provided. Furthermore, the @getChanContents@
-- function is not provided as it needs unsafe I/O.
module Control.Concurrent.Classy.Chan
  ( -- * The 'Chan' type
    Chan

  -- * Operations
  , newChan
  , writeChan
  , readChan
  , dupChan

  -- * Stream interface
  , writeList2Chan
  ) where

import           Control.Concurrent.Classy.MVar
import           Control.Monad.Catch            (mask_)
import           Control.Monad.Conc.Class       (MonadConc)

-- | 'Chan' is an abstract type representing an unbounded FIFO
-- channel.
--
-- @since 1.0.0.0
data Chan m a
  = Chan (MVar m (Stream m a))
         (MVar m (Stream m a)) -- Invariant: the Stream a is always an empty MVar

type Stream m a = MVar m (ChItem m a)

data ChItem m a = ChItem a (Stream m a)

-- | Build and returns a new instance of 'Chan'.
--
-- @since 1.0.0.0
newChan :: MonadConc m => m (Chan m a)
newChan :: forall (m :: * -> *) a. MonadConc m => m (Chan m a)
newChan = do
  MVar m (ChItem m a)
hole  <- m (MVar m (ChItem m a))
forall a. m (MVar m a)
forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
  MVar m (MVar m (ChItem m a))
readVar  <- MVar m (ChItem m a) -> m (MVar m (MVar m (ChItem m a)))
forall (m :: * -> *) a. MonadConc m => a -> m (MVar m a)
newMVar MVar m (ChItem m a)
hole
  MVar m (MVar m (ChItem m a))
writeVar <- MVar m (ChItem m a) -> m (MVar m (MVar m (ChItem m a)))
forall (m :: * -> *) a. MonadConc m => a -> m (MVar m a)
newMVar MVar m (ChItem m a)
hole
  Chan m a -> m (Chan m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVar m (MVar m (ChItem m a))
-> MVar m (MVar m (ChItem m a)) -> Chan m a
forall (m :: * -> *) a.
MVar m (Stream m a) -> MVar m (Stream m a) -> Chan m a
Chan MVar m (MVar m (ChItem m a))
readVar MVar m (MVar m (ChItem m a))
writeVar)

-- | Write a value to a 'Chan'.
--
-- @since 1.0.0.0
writeChan :: MonadConc m => Chan m a -> a -> m ()
writeChan :: forall (m :: * -> *) a. MonadConc m => Chan m a -> a -> m ()
writeChan (Chan MVar m (Stream m a)
_ MVar m (Stream m a)
writeVar) a
val = do
  Stream m a
new_hole <- m (Stream m a)
forall a. m (MVar m a)
forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
  m () -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
mask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Stream m a
old_hole <- MVar m (Stream m a) -> m (Stream m a)
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar MVar m (Stream m a)
writeVar
    Stream m a -> ChItem m a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar Stream m a
old_hole (a -> Stream m a -> ChItem m a
forall (m :: * -> *) a. a -> Stream m a -> ChItem m a
ChItem a
val Stream m a
new_hole)
    MVar m (Stream m a) -> Stream m a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m (Stream m a)
writeVar Stream m a
new_hole

-- | Read the next value from the 'Chan'.
--
-- @since 1.0.0.0
readChan :: MonadConc m => Chan m a -> m a
readChan :: forall (m :: * -> *) a. MonadConc m => Chan m a -> m a
readChan (Chan MVar m (Stream m a)
readVar MVar m (Stream m a)
_) =  MVar m (Stream m a) -> (Stream m a -> m (Stream m a, a)) -> m a
forall (m :: * -> *) a b.
MonadConc m =>
MVar m a -> (a -> m (a, b)) -> m b
modifyMVarMasked MVar m (Stream m a)
readVar ((Stream m a -> m (Stream m a, a)) -> m a)
-> (Stream m a -> m (Stream m a, a)) -> m a
forall a b. (a -> b) -> a -> b
$ \Stream m a
read_end -> do
  (ChItem a
val Stream m a
new_read_end) <- Stream m a -> m (ChItem m a)
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
readMVar Stream m a
read_end
  (Stream m a, a) -> m (Stream m a, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stream m a
new_read_end, a
val)

-- | Duplicate a 'Chan': the duplicate channel begins empty, but data
-- written to either channel from then on will be available from both.
-- Hence this creates a kind of broadcast channel, where data written
-- by anyone is seen by everyone else.
--
-- @since 1.0.0.0
dupChan :: MonadConc m => Chan m a -> m (Chan m a)
dupChan :: forall (m :: * -> *) a. MonadConc m => Chan m a -> m (Chan m a)
dupChan (Chan MVar m (Stream m a)
_ MVar m (Stream m a)
writeVar) = do
  Stream m a
hole       <- MVar m (Stream m a) -> m (Stream m a)
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
readMVar MVar m (Stream m a)
writeVar
  MVar m (Stream m a)
newReadVar <- Stream m a -> m (MVar m (Stream m a))
forall (m :: * -> *) a. MonadConc m => a -> m (MVar m a)
newMVar Stream m a
hole
  Chan m a -> m (Chan m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVar m (Stream m a) -> MVar m (Stream m a) -> Chan m a
forall (m :: * -> *) a.
MVar m (Stream m a) -> MVar m (Stream m a) -> Chan m a
Chan MVar m (Stream m a)
newReadVar MVar m (Stream m a)
writeVar)

-- | Write an entire list of items to a 'Chan'.
--
-- @since 1.0.0.0
writeList2Chan :: MonadConc m => Chan m a -> [a] -> m ()
writeList2Chan :: forall (m :: * -> *) a. MonadConc m => Chan m a -> [a] -> m ()
writeList2Chan = (a -> m ()) -> [a] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((a -> m ()) -> [a] -> m ())
-> (Chan m a -> a -> m ()) -> Chan m a -> [a] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chan m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => Chan m a -> a -> m ()
writeChan