sharedvec.hs

sharedvec.hs

module Main where

import Control.Concurrent          as CC
import Control.Concurrent.STM      as STM
import Control.Concurrent.STM.TVar as TV
import Data.Vector                 as V
import GHC.Conc                    as GC

modifyTVar :: TVar a -> (a -> a) -> STM ()
modifyTVar tv f = readTVar tv >>= writeTVar tv . f

-- atomically write Ints to the Int Vector                                      
readerThread :: STM.TChan Int -> STM.TVar (V.Vector Int) -> IO ()
readerThread chan v = do
  STM.atomically $ do
    i <- STM.readTChan chan
    modifyTVar v (\v' -> (V.cons i v'))
    -- print it out to make sure the work was done                              
    v' <- TV.readTVar v
    GC.unsafeIOToSTM $ print $ show $ V.toList v'
    return ()
  readerThread chan v

main :: IO ()
main = do
  -- the communications channel                                                 
  chan <- STM.atomically $ STM.newTChan
  -- build the STM Vector                                                       
  let v = V.empty :: V.Vector Int
  tv <- STM.atomically $ STM.newTVar (V.empty :: V.Vector Int)
  -- listen for changes to the chan                                             
  forkIO $ readerThread chan tv
  -- write some data to the chan, which will be written into the Vector         
  c <- STM.atomically $ STM.newTVar (1 :: Int)
  v1 <- STM.atomically $ do
    t <- STM.readTVar c
    STM.writeTVar c (t+2)
    STM.writeTChan chan t
    return t
  -- this should be prepended to the Vector                                     
  print $ show v1
  v2 <- STM.atomically $ do
    t <- STM.readTVar c
    STM.writeTChan chan t
    return t
  -- this should be prepended to the vector 
  print $ show v2
  CC.threadDelay $ 1000000
  -- show the Vector again in the main scope                                    
  STM.atomically $ do
    v' <- TV.readTVar tv                                                        
    GC.unsafeIOToSTM $ print $ show $ V.toList v'                               
    return ()
  return ()