04ac36c · vty · git.iko.soy

src/Graphics/Vty.hs+2−2

compare with master

unifiedsplit

@@ -59,7 +59,7 @@ import Graphics.Vty.Input

59import Graphics.Vty.Output

60import Graphics.Vty.Picture

61

62−import Control.Concurrent

62+import Control.Concurrent.STM

63

64import Data.IORef

65import Data.Monoid

@@ -165,7 +165,7 @@ intMkVty input out = do

165 >> readIORef lastPicRef

166 >>= maybe ( return () ) ( \pic -> innerUpdate pic )

167

168− let gkey = do k <- readChan $ _eventChannel input

168+ let gkey = do k <- atomically $ readTChan $ _eventChannel input

169 case k of

170 (EvResize _ _) -> innerRefresh

171 >> displayBounds out

src/Graphics/Vty/Input.hs+2−2

@@ -136,7 +136,7 @@ import Graphics.Vty.Input.Events

136import Graphics.Vty.Input.Loop

137import Graphics.Vty.Input.Terminfo

138

139−import Control.Concurrent

139+import Control.Concurrent.STM

140import Control.Lens

141

142import qualified System.Console.Terminfo as Terminfo

@@ -193,7 +193,7 @@ inputForConfig config@Config{ termName = Just termName

193 let pokeIO = Catch $ do

194 let e = error "vty internal failure: this value should not propagate to users"

195 setAttrs

196− writeChan (input^.eventChannel) (EvResize e e)

196+ atomically $ writeTChan (input^.eventChannel) (EvResize e e)

197 _ <- installHandler windowChange pokeIO Nothing

198 _ <- installHandler continueProcess pokeIO Nothing

199 return $ input

src/Graphics/Vty/Input/Loop.hs+4−3

@@ -19,6 +19,7 @@ import Graphics.Vty.Input.Events

19

20import Control.Applicative

21import Control.Concurrent

22+import Control.Concurrent.STM

22import Control.Exception (mask, try, SomeException)

23import Control.Exception (mask, try, SomeException)

23import Control.Lens

24import Control.Lens

24import Control.Monad (when, mzero, forM_)

25import Control.Monad (when, mzero, forM_)

@@ -43,7 +44,7 @@ import Text.Printf (hPrintf)

43data Input = Input

44data Input = Input

44 { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh

45 { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh

45 -- the display if the next event is an 'EvResize'.

46 -- the display if the next event is an 'EvResize'.

46− _eventChannel :: Chan Event

47+ _eventChannel :: TChan Event

47 -- | Shuts down the input processing. This should return the terminal input state to before

48 -- | Shuts down the input processing. This should return the terminal input state to before

48 -- the input initialized.

49 -- the input initialized.

49 , shutdownInput :: IO ()

50 , shutdownInput :: IO ()

@@ -96,7 +97,7 @@ addBytesToProcess block = unprocessedBytes <>= block

96emit :: Event -> InputM ()

97emit :: Event -> InputM ()

97emit event = do

98emit event = do

98 logMsg $ "parsed event: " ++ show event

99 logMsg $ "parsed event: " ++ show event

99− view eventChannel >>= liftIO . flip writeChan event

100+ view eventChannel >>= liftIO . atomically . flip writeTChan event

100

101

101-- The timing requirements are assured by the VMIN and VTIME set for the device.

102-- The timing requirements are assured by the VMIN and VTIME set for the device.

102--

103--

@@ -192,7 +193,7 @@ initInput config classifyTable = do

192 setFdOption fd NonBlockingRead False

193 setFdOption fd NonBlockingRead False

193 applyConfig fd config

194 applyConfig fd config

194 stopSync <- newEmptyMVar

195 stopSync <- newEmptyMVar

195− input <- Input <$> newChan

196+ input <- Input <$> atomically newTChan

196 <*> pure (return ())

197 <*> pure (return ())

197 <*> newIORef config

198 <*> newIORef config

198 <*> maybe (return Nothing)

199 <*> maybe (return Nothing)

test/VerifyUsingMockInput.hs+2−1

@@ -14,6 +14,7 @@ import Graphics.Vty.Input.Terminfo

14

15import Control.Applicative

16import Control.Concurrent

17+import Control.Concurrent.STM

17import Control.Exception

18import Control.Exception

18import Control.Lens ((^.))

19import Control.Lens ((^.))

19import Control.Monad

20import Control.Monad

@@ -128,7 +129,7 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

128 let readEvents = readLoop eventCount

129 let readEvents = readLoop eventCount

129 readLoop 0 = return ()

130 readLoop 0 = return ()

130 readLoop n = do

131 readLoop n = do

131− e <- readChan $ input^.eventChannel

132+ e <- atomically $ readTChan $ input^.eventChannel

132 modifyIORef eventsRef ((:) e)

133 modifyIORef eventsRef ((:) e)

133 readLoop (n - 1)

134 readLoop (n - 1)

134 genEventsUsingIoActions maxDuration writeWaitClose readEvents

135 genEventsUsingIoActions maxDuration writeWaitClose readEvents

vty.cabal+2

@@ -59,6 +59,7 @@ library

59 mtl >= 1.1.1.0 && < 2.3,

60 parallel >= 2.2 && < 3.3,

61 parsec >= 2 && < 4,

62+ stm,

62 terminfo >= 0.3 && < 0.5,

63 terminfo >= 0.3 && < 0.5,

63 transformers >= 0.3.0.0,

64 transformers >= 0.3.0.0,

64 text >= 0.11.3,

65 text >= 0.11.3,

@@ -564,6 +565,7 @@ test-suite verify-using-mock-input

564 deepseq >= 1.1 && < 1.5,

565 deepseq >= 1.1 && < 1.5,

565 lens >= 3.9.0.2 && < 5.0,

566 lens >= 3.9.0.2 && < 5.0,

566 mtl >= 1.1.1.0 && < 2.3,

567 mtl >= 1.1.1.0 && < 2.3,

568+ stm,

567 terminfo >= 0.3 && < 0.5,

569 terminfo >= 0.3 && < 0.5,

568 text >= 0.11.3,

570 text >= 0.11.3,

569 unix,

571 unix,