From 0d6c67cb9ea75c3afc343dcc9e6e9e0318e1b260 Mon Sep 17 00:00:00 2001
From: tv <tv@nomic.retiolum>
Date: Sat, 27 Feb 2016 04:56:51 +0100
Subject: test5: s/shutdown/EShutdown/g

---
 Event.hs |  1 +
 test5.hs | 36 +++++++++++++++++-------------------
 2 files changed, 18 insertions(+), 19 deletions(-)

diff --git a/Event.hs b/Event.hs
index 1aa718a..5790aac 100644
--- a/Event.hs
+++ b/Event.hs
@@ -6,6 +6,7 @@ import Scanner
 data Event =
     EFlash (Blessings String) |
     EScan Scan |
+    EShutdown |
     EReload |
     EResize Int Int
   deriving Show
diff --git a/test5.hs b/test5.hs
index 1200c39..718c449 100644
--- a/test5.hs
+++ b/test5.hs
@@ -140,24 +140,18 @@ runState q0 = do
         v <- newEmptyMVar
         return (putMVar v, takeMVar v)
 
-    (shutdown, waitForShutdown) <- do
-        v <- newEmptyMVar
-        return (putMVar v (), takeMVar v)
-
-
     mapM_ (\(s, f) -> installHandler s (Catch f) Nothing)
-        [ (sigINT, shutdown)
+        [ (sigINT, putEvent EShutdown)
         , (28, winchHandler putEvent)
         ]
 
     threadIds <- mapM forkIO
         [ forever $ scan stdin >>= putEvent . EScan
-        , run getEvent q0
         ]
 
     winchHandler putEvent
 
-    waitForShutdown
+    run getEvent q1
     mapM_ killThread threadIds
 
 
@@ -171,28 +165,32 @@ winchHandler putEvent =
 
 
 run :: IO Event -> State -> IO ()
-run getEvent = rec where
-    rec q = rec =<< do
-        t <- getCurrentTime
-        let q' = render q { now = t }
-        redraw q' >> getEvent >>= processEvent q'
+run getEvent = rec . Right where
+    rec = \case
+        Right q -> rec =<< do
+            t <- getCurrentTime
+            let q' = render q { now = t }
+            redraw q' >> getEvent >>= processEvent q'
+        Left _q -> return ()
 
 
-processEvent :: State -> Event -> IO State
+processEvent :: State -> Event -> IO (Either State State)
 processEvent q = \case
     EFlash t ->
-        return q { flashMessage = t }
+        return $ Right q { flashMessage = t }
     EScan (ScanKey s) ->
-        keymap s q
+        Right <$> keymap s q
     EScan info@ScanMouse{..} ->
-        mousemap info q
+        Right <$> mousemap info q
+    EShutdown ->
+        return $ Left q
     EResize w h ->
-        return q
+        return $ Right q
             { screenWidth = w, screenHeight = h
             , flashMessage = Plain $ "resize " <> show (w,h)
             }
     ev ->
-        return q
+        return $ Right q
             { flashMessage = SGR [31,1] $ Plain $ "unhandled event: " <> show ev
             }
 
-- 
cgit v1.2.3