2cd98a8 · vty · git.iko.soy

git.iko.soy/vty

Wrap internal events in a new InternalEvent type to improve how signal handling is done

This change modifies the Input type's event channel API to produce InternalEvents, not Events. The new InternalEvent either wraps Event with the InputEvent constructor (the previous behavior) or indicates that Vty resumed after handling a signal using the ResumeAfterSignal constructor. This change avoids the previous use of EvResize with lazy exception arguments as a sentinel value for ResumeAfterSignal.

commit2cd98a862c88069e3863ad0ad989dfa0e9081d29 authorJonathan Daugherty <cygnus@foobox.com> dateMon 14 Mar 2022, 12:56 (5 years ago) parent4969735

4 files changed+24−12

compare with master

unifiedsplit

src/Graphics/Vty.hs+11−8 src/Graphics/Vty/Input.hs+1−2 src/Graphics/Vty/Input/Events.hs+10 src/Graphics/Vty/Input/Loop.hs+2−2

src/Graphics/Vty.hs+11−8

@@ -48,6 +48,7 @@ where

4848

4949import Graphics.Vty.Config

5050import Graphics.Vty.Input

51+import Graphics.Vty.Input.Events

5152import Graphics.Vty.Output

5253import Graphics.Vty.Output.Interface

5354import Graphics.Vty.Picture

@@ -209,16 +210,18 @@ internalMkVty input out = do

209210 maybe (return ()) innerUpdate mPic

210211

211212 let mkResize = uncurry EvResize <$> displayBounds out

213+

214+ handleInternalEvent ResumeAfterSignal = mkResize

215+ handleInternalEvent (InputEvent e) = return e

216+

212217 gkey = do

213− k <- atomically $ readTChan $ _eventChannel input

214− case k of

215− (EvResize _ _) -> mkResize

216− _ -> return k

218+ e <- atomically $ readTChan $ _eventChannel input

219+ handleInternalEvent e

217220 gkey' = do

218− k <- atomically $ tryReadTChan $ _eventChannel input

219− case k of

220− (Just (EvResize _ _)) -> Just <$> mkResize

221− _ -> return k

221+ mEv <- atomically $ tryReadTChan $ _eventChannel input

222+ case mEv of

223+ Just e -> Just <$> handleInternalEvent e

224+ Nothing -> return Nothing

222225

223226 return $ Vty { update = innerUpdate

224227 , nextEvent = gkey

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

@@ -158,9 +158,8 @@ inputForConfig config@Config{ termName = Just termName

158158 setAttrs

159159 input <- initInput config activeInputMap

160160 let pokeIO = Catch $ do

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

162161 setAttrs

163− atomically $ writeTChan (input^.eventChannel) (EvResize e e)

162+ atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal

164163 _ <- installHandler windowChange pokeIO Nothing

165164 _ <- installHandler continueProcess pokeIO Nothing

166165

src/Graphics/Vty/Input/Events.hs+10

@@ -76,3 +76,13 @@ data Event

7676instance NFData Event

7777

7878type ClassifyMap = [(String,Event)]

79+

80+-- | The type of internal events that drive the internal Vty event

81+-- dispatching to the application.

82+data InternalEvent =

83+ ResumeAfterSignal

84+ -- ^ Vty resumed operation after the process was interrupted with a

85+ -- signal. In practice this translates into a screen redraw in the

86+ -- input event loop.

87+ | InputEvent Event

88+ -- ^ An input event was received.

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

@@ -55,7 +55,7 @@ data Input = Input

5555 { -- | Channel of events direct from input processing. Unlike

5656 -- 'nextEvent' this will not refresh the display if the next event

5757 -- is an 'EvResize'.

58− _eventChannel :: TChan Event

58+ _eventChannel :: TChan InternalEvent

5959 -- | Shuts down the input processing. As part of shutting down the

6060 -- input, this should also restore the input state.

6161 , shutdownInput :: IO ()

@@ -115,7 +115,7 @@ addBytesToProcess block = unprocessedBytes <>= block

115115emit :: Event -> InputM ()

116116emit event = do

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

118− view eventChannel >>= liftIO . atomically . flip writeTChan event

118+ view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)

119119

120120-- The timing requirements are assured by the VMIN and VTIME set for the

121121-- device.