haskell MVAr channel and multicast channel impl

channel.hs

#!/usr/bin/env stack
{-
 stack
--resolver lts-17.13 runghc
-}
--
--  chapter-7, Parallel-concurrent-programming in haskell
-- chmod 755 ./channel.hs && ./channel.hs
--
{-# LANGUAGE OverloadedStrings #-}

import           Control.Concurrent(MVar, takeMVar, readMVar, putMVar, newMVar, newEmptyMVar)

type Stream a = MVar (Item a)
data Item a = Item a (Stream a)
data Chan a = Chan (MVar ( Stream a )) (MVar ( Stream a ))

{-
The read pointer always points to the next item to be read from the channel, and the
write pointer points to the hole into which the next item written will be placed
-}


{-
To construct a new channel:
- first create an empty Stream , which is just a single empty MVar
- then the Chan constructor with MVar s for the read and write ends, both pointing to the empty Stream
-}
newChan  :: IO (Chan a)
newChan =  do
  hole <- newEmptyMVar
  readVar <- newMVar hole
  writeVar <- newMVar hole
  return (Chan readVar writeVar)

{-
To add a new element to the channel:
- make an Item with a new hole
- fill in the current hole to point to the new item
- adjust the write-end of the Chan to point to the new hole
-}
writeChan :: Chan a -> a -> IO ()
writeChan (Chan _ writeVar) val = do
  newHole <- newEmptyMVar
  oldHole <- takeMVar writeVar
  putMVar oldHole (Item val newHole)
  putMVar writeVar newHole

readChan :: Chan a -> IO a
readChan  (Chan readVar _) = do
  stream <- takeMVar  readVar
  Item val tail <- takeMVar stream
  putMVar readVar tail
  return val

-- multicast
dupChan :: Chan a -> IO (Chan a)
dupChan (Chan _ writeVar) = do
  hole <- readMVar writeVar
  newReadVar <- newMVar hole
  return (Chan newReadVar writeVar )


main :: IO ()
main = do
  channe1 <- newChan
  writeChan channe1 "hello-from channel-1"
  s <- readChan channe1
  putStrLn s