04ac36c · vty · git.iko.soy

git.iko.soy/vty

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

commit04ac36ca76b087662d035fdc48aae93866528783 authorJonathan Daugherty <cygnus@foobox.com> dateSun 9 Aug 2015, 19:22 (11 years ago) parent60e8ce6

5 files changed+12−8

compare with master

unifiedsplit

src/Graphics/Vty.hs+2−2 src/Graphics/Vty/Input.hs+2−2 src/Graphics/Vty/Input/Loop.hs+4−3 test/VerifyUsingMockInput.hs+2−1 vty.cabal+2

src/Graphics/Vty.hs+2−2

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

5959import Graphics.Vty.Output

6060import Graphics.Vty.Picture

6161

62−import Control.Concurrent

62+import Control.Concurrent.STM

6363

6464import Data.IORef

6565import Data.Monoid

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

165165 >> readIORef lastPicRef

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

167167

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

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

169169 case k of

170170 (EvResize _ _) -> innerRefresh

171171 >> displayBounds out

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

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

136136import Graphics.Vty.Input.Loop

137137import Graphics.Vty.Input.Terminfo

138138

139−import Control.Concurrent

139+import Control.Concurrent.STM

140140import Control.Lens

141141

142142import qualified System.Console.Terminfo as Terminfo

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

193193 let pokeIO = Catch $ do

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

195195 setAttrs

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

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

197197 _ <- installHandler windowChange pokeIO Nothing

198198 _ <- installHandler continueProcess pokeIO Nothing

199199 return $ input

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

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

1919

2020import Control.Applicative

2121import Control.Concurrent

22+import Control.Concurrent.STM

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

2324import Control.Lens

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

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

4344data Input = Input

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

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

46− _eventChannel :: Chan Event

47+ _eventChannel :: TChan Event

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

4849 -- the input initialized.

4950 , shutdownInput :: IO ()

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

9697emit :: Event -> InputM ()

9798emit event = do

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

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

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

100101

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

102103--

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

192193 setFdOption fd NonBlockingRead False

193194 applyConfig fd config

194195 stopSync <- newEmptyMVar

195− input <- Input <$> newChan

196+ input <- Input <$> atomically newTChan

196197 <*> pure (return ())

197198 <*> newIORef config

198199 <*> maybe (return Nothing)

test/VerifyUsingMockInput.hs+2−1

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

1414

1515import Control.Applicative

1616import Control.Concurrent

17+import Control.Concurrent.STM

1718import Control.Exception

1819import Control.Lens ((^.))

1920import Control.Monad

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

128129 let readEvents = readLoop eventCount

129130 readLoop 0 = return ()

130131 readLoop n = do

131− e <- readChan $ input^.eventChannel

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

132133 modifyIORef eventsRef ((:) e)

133134 readLoop (n - 1)

134135 genEventsUsingIoActions maxDuration writeWaitClose readEvents

vty.cabal+2

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

5959 mtl >= 1.1.1.0 && < 2.3,

6060 parallel >= 2.2 && < 3.3,

6161 parsec >= 2 && < 4,

62+ stm,

6263 terminfo >= 0.3 && < 0.5,

6364 transformers >= 0.3.0.0,

6465 text >= 0.11.3,

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

564565 deepseq >= 1.1 && < 1.5,

565566 lens >= 3.9.0.2 && < 5.0,

566567 mtl >= 1.1.1.0 && < 2.3,

568+ stm,

567569 terminfo >= 0.3 && < 0.5,

568570 text >= 0.11.3,

569571 unix,