summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@nomic.retiolum>2016-02-27 04:56:51 +0100
committertv <tv@nomic.retiolum>2016-02-27 04:56:51 +0100
commit0d6c67cb9ea75c3afc343dcc9e6e9e0318e1b260 (patch)
treeb9453b9efdfd17c4a2d1a1eb4122acedc0dae8c6
parent9e405abdd7211f1edc5ef9ac28672eba8cd7ff2f (diff)
test5: s/shutdown/EShutdown/g
-rw-r--r--Event.hs1
-rw-r--r--test5.hs36
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
}