Use STM chans to avoid deprecated interface (fixes #60)

src/Graphics/Vty.hs

@@ -59,7 +59,7 @@ import Graphics.Vty.Input
 import Graphics.Vty.Output
 import Graphics.Vty.Picture
 
-import Control.Concurrent
+import Control.Concurrent.STM
 
 import Data.IORef
 import Data.Monoid
@@ -165,7 +165,7 @@ intMkVty input out = do
             >>  readIORef lastPicRef 
             >>= maybe ( return () ) ( \pic -> innerUpdate pic ) 
 
-    let gkey = do k <- readChan $ _eventChannel input
+    let gkey = do k <- atomically $ readTChan $ _eventChannel input
                   case k of 
                     (EvResize _ _)  -> innerRefresh
                                        >> displayBounds out

src/Graphics/Vty/Input.hs

@@ -136,7 +136,7 @@ import Graphics.Vty.Input.Events
 import Graphics.Vty.Input.Loop
 import Graphics.Vty.Input.Terminfo
 
-import Control.Concurrent
+import Control.Concurrent.STM
 import Control.Lens
 
 import qualified System.Console.Terminfo as Terminfo
@@ -193,7 +193,7 @@ inputForConfig config@Config{ termName = Just termName
     let pokeIO = Catch $ do
             let e = error "vty internal failure: this value should not propagate to users"
             setAttrs
-            writeChan (input^.eventChannel) (EvResize e e)
+            atomically $ writeTChan (input^.eventChannel) (EvResize e e)
     _ <- installHandler windowChange pokeIO Nothing
     _ <- installHandler continueProcess pokeIO Nothing
     return $ input

src/Graphics/Vty/Input/Loop.hs

@@ -19,6 +19,7 @@ import Graphics.Vty.Input.Events
 
 import Control.Applicative
 import Control.Concurrent
+import Control.Concurrent.STM
 import Control.Exception (mask, try, SomeException)
 import Control.Lens
 import Control.Monad (when, mzero, forM_)
@@ -43,7 +44,7 @@ import Text.Printf (hPrintf)
 data Input = Input
     { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh
       -- the display if the next event is an 'EvResize'.
-      _eventChannel  :: Chan Event
+      _eventChannel  :: TChan Event
       -- | Shuts down the input processing. This should return the terminal input state to before
       -- the input initialized.
     , shutdownInput :: IO ()
@@ -96,7 +97,7 @@ addBytesToProcess block = unprocessedBytes <>= block
 emit :: Event -> InputM ()
 emit event = do
     logMsg $ "parsed event: " ++ show event
-    view eventChannel >>= liftIO . flip writeChan event
+    view eventChannel >>= liftIO . atomically . flip writeTChan event
 
 -- The timing requirements are assured by the VMIN and VTIME set for the device.
 --
@@ -192,7 +193,7 @@ initInput config classifyTable = do
     setFdOption fd NonBlockingRead False
     applyConfig fd config
     stopSync <- newEmptyMVar
-    input <- Input <$> newChan
+    input <- Input <$> atomically newTChan
                    <*> pure (return ())
                    <*> newIORef config
                    <*> maybe (return Nothing)

test/VerifyUsingMockInput.hs

@@ -14,6 +14,7 @@ import Graphics.Vty.Input.Terminfo
 
 import Control.Applicative
 import Control.Concurrent
+import Control.Concurrent.STM
 import Control.Exception
 import Control.Lens ((^.))
 import Control.Monad
@@ -128,7 +129,7 @@ assertEventsFromSynInput table inputSpec expectedEvents = do
     let readEvents = readLoop eventCount
         readLoop 0 = return ()
         readLoop n = do
-            e <- readChan $ input^.eventChannel
+            e <- atomically $ readTChan $ input^.eventChannel
             modifyIORef eventsRef ((:) e)
             readLoop (n - 1)
     genEventsUsingIoActions maxDuration writeWaitClose readEvents

vty.cabal

@@ -59,6 +59,7 @@ library
                        mtl >= 1.1.1.0 && < 2.3,
                        parallel >= 2.2 && < 3.3,
                        parsec >= 2 && < 4,
+                       stm,
                        terminfo >= 0.3 && < 0.5,
                        transformers >= 0.3.0.0,
                        text >= 0.11.3,
@@ -564,6 +565,7 @@ test-suite verify-using-mock-input
                        deepseq >= 1.1 && < 1.5,
                        lens >= 3.9.0.2 && < 5.0,
                        mtl >= 1.1.1.0 && < 2.3,
+                       stm,
                        terminfo >= 0.3 && < 0.5,
                        text >= 0.11.3,
                        unix,