STM not working

gistfile1.hs

module Main (main) where
--------------------------------------------------------------------------------
 
import qualified Graphics.UI.GLFW as GLFW
import qualified Graphics.Rendering.OpenGL as GL
 
import Control.Concurrent.STM
import Control.Monad (unless)
 
import qualified Data.Set as Set
 
--------------------------------------------------------------------------------
 
main :: IO ()
main = do
  GLFW.init
  (Just win) <- GLFW.createWindow 640 480 "blah" Nothing Nothing
  GLFW.makeContextCurrent (Just win)
  ctl <- newTVarIO Set.empty
  runWin win ctl 0
  GLFW.destroyWindow win
  GLFW.terminate
    where
      runWin :: GLFW.Window -> TVar (Set.Set GLFW.Key) -> GL.GLfloat -> IO ()
      runWin win ctl t = do
 
        GL.clearColor GL.$= GL.Color4 (abs $ sin t) (abs $ cos t) (abs $ sin (t+0.3)) 1
        GL.clear [GL.ColorBuffer, GL.DepthBuffer]
        GL.flush
        GLFW.swapBuffers win
        
        input <- readTVarIO ctl
        if Set.member GLFW.Key'Q input
          then GLFW.setWindowShouldClose win True
          else return ()
        q <- GLFW.windowShouldClose win
        unless q $ runWin win ctl (t + 0.005)