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.

src/Graphics/Vty.hs

@@ -48,6 +48,7 @@ where
 
 import Graphics.Vty.Config
 import Graphics.Vty.Input
+import Graphics.Vty.Input.Events
 import Graphics.Vty.Output
 import Graphics.Vty.Output.Interface
 import Graphics.Vty.Picture
@@ -209,16 +210,18 @@ internalMkVty input out = do
             maybe (return ()) innerUpdate mPic
 
     let mkResize = uncurry EvResize <$> displayBounds out
+
+        handleInternalEvent ResumeAfterSignal = mkResize
+        handleInternalEvent (InputEvent e)    = return e
+
         gkey = do
-            k <- atomically $ readTChan $ _eventChannel input
+            e <- atomically $ readTChan $ _eventChannel input
-            case k of
+            handleInternalEvent e
-                (EvResize _ _)  -> mkResize
-                _ -> return k
         gkey' = do
-            k <- atomically $ tryReadTChan $ _eventChannel input
+            mEv <- atomically $ tryReadTChan $ _eventChannel input
-            case k of
+            case mEv of
-                (Just (EvResize _ _))  -> Just <$> mkResize
+                Just e  -> Just <$> handleInternalEvent e
-                _ -> return k
+                Nothing -> return Nothing
 
     return $ Vty { update = innerUpdate
                  , nextEvent = gkey

src/Graphics/Vty/Input.hs

@@ -158,9 +158,8 @@ inputForConfig config@Config{ termName = Just termName
     setAttrs
     input <- initInput config activeInputMap
     let pokeIO = Catch $ do
-            let e = error "vty internal failure: this value should not propagate to users"
             setAttrs
-            atomically $ writeTChan (input^.eventChannel) (EvResize e e)
+            atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal
     _ <- installHandler windowChange pokeIO Nothing
     _ <- installHandler continueProcess pokeIO Nothing
 

src/Graphics/Vty/Input/Events.hs

@@ -76,3 +76,13 @@ data Event
 instance NFData Event
 
 type ClassifyMap = [(String,Event)]
+
+-- | The type of internal events that drive the internal Vty event
+-- dispatching to the application.
+data InternalEvent =
+    ResumeAfterSignal
+    -- ^ Vty resumed operation after the process was interrupted with a
+    -- signal. In practice this translates into a screen redraw in the
+    -- input event loop.
+    | InputEvent Event
+    -- ^ An input event was received.

src/Graphics/Vty/Input/Loop.hs

@@ -55,7 +55,7 @@ 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  :: TChan Event
+      _eventChannel  :: TChan InternalEvent
       -- | Shuts down the input processing. As part of shutting down the
       -- input, this should also restore the input state.
     , shutdownInput :: IO ()
@@ -115,7 +115,7 @@ addBytesToProcess block = unprocessedBytes <>= block
 emit :: Event -> InputM ()
 emit event = do
     logMsg $ "parsed event: " ++ show event
-    view eventChannel >>= liftIO . atomically . flip writeTChan event
+    view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)
 
 -- The timing requirements are assured by the VMIN and VTIME set for the
 -- device.