tupleaccess.hs

import Control.Concurrent.STM
import qualified Data.Map as M
import Data.Maybe

main = do
  pendingV <- atomically $ newTVar M.empty
  let handleFst (key, ourVal) =
        atomically $ do
          pending <- readTVar pendingV
          case M.lookup key pending of
            Just (Right theirVal) -> return $ Just (ourVal, theirVal)
            _ -> do
              writeTVar pendingV $ M.insert key (Left ourVal) pending
              return Nothing
  let handleSnd (key, ourVal) =
        atomically $ do
          pending <- readTVar pendingV
          case M.lookup key pending of
            Just (Left theirVal) -> return $ Just (theirVal, ourVal)
            _ -> do
              writeTVar pendingV $ M.insert key (Right ourVal) pending
              return Nothing
  results <-
    sequence
      [ handleFst (1, "a1")
      , handleSnd (2, True)
      , handleSnd (1, False)
      , handleFst (2, "a2")
      ]
  print $ catMaybes results
  return ()