content: module WindowManager where
  
  import Control.Concurrent.STM
  import Data.Map as Map
  import Data.Set as Set
  import Data.Maybe
  
  data Window
  instance Eq Window
  instance Ord Window
  
  data Desktop
  instance Eq Desktop
  instance Ord Desktop
  
  type Display = Map Desktop (TVar (Set Window))
  
  -- <<moveWindowSTM
  moveWindowSTM :: Display -> Window -> Desktop -> Desktop -> STM ()
  moveWindowSTM disp win a b = do
    wa <- readTVar ma
    wb <- readTVar mb
    writeTVar ma (Set.delete win wa)
    writeTVar mb (Set.insert win wb)
   where
    ma = disp ! a
    mb = disp ! b
  -- >>
  
  -- <<moveWindow
  moveWindow :: Display -> Window -> Desktop -> Desktop -> IO ()
  moveWindow disp win a b = atomically $ moveWindowSTM disp win a b
  -- >>
  
  -- <<swapWindows
  swapWindows :: Display
              -> Window -> Desktop
              -> Window -> Desktop
              -> IO ()
  swapWindows disp w a v b = atomically $ do
    moveWindowSTM disp w a b
    moveWindowSTM disp v b a
  -- >>
  
  render :: Set Window -> IO ()
  render = undefined
  
  -- <<UserFocus
  type UserFocus = TVar Desktop
  -- >>
  
  -- <<getWindows
  getWindows :: Display -> UserFocus -> STM (Set Window)
  getWindows disp focus = do
    desktop <- readTVar focus
    readTVar (disp ! desktop)
  -- >>
  
  -- <<renderThread
  renderThread :: Display -> UserFocus -> IO ()
  renderThread disp focus = do
    wins <- atomically $ getWindows disp focus    -- <1>
    loop wins                                     -- <2>
   where
    loop wins = do                                -- <3>
      render wins                                 -- <4>
      next <- atomically $ do
                 wins' <- getWindows disp focus   -- <5>
                 if (wins == wins')               -- <6>
                     then retry                   -- <7>
                     else return wins'            -- <8>
      loop next
  -- >>
  
  