implement signal handling

1 files changed, 19 insertions, 3 deletions

diff --git a/highway/Main.hs b/highway/Main.hs
index 17b768d..d387466 100644
--- a/highway/Main.hs
+++ b/highway/Main.hs
@@ -2,7 +2,7 @@
 
 import Wayland.Server
 import Lens.Micro.TH (makeLenses)
-import Lens.Micro.Mtl ((%=))
+import Lens.Micro.Mtl ((%=), (<%=))
 import Data.Data (Typeable)
 import Control.Monad (void)
 import Control.Monad.Trans (liftIO)
@@ -24,9 +24,21 @@ data BindRequest
   = BindOutput WLOutput.Handle
   deriving (Typeable, Show)
 
+data SignalRequest
+  = ReqSIGINT
+  deriving (Typeable, Show)
+
+instance RequestClass SignalRequest
+instance RequestClass BindRequest
+
 data Output = Output
+  deriving (Show)
+
+data State = State { _outputs          :: M.Map WLOutput.Handle Output
+                   , _interruptedCount :: Int
+                   }
+  deriving (Show)
 
-data State = State { _outputs :: M.Map WLOutput.Handle Output }
 makeLenses ''State
 
 handleRequest :: Request -> DisplayM State ()
@@ -37,12 +49,16 @@ handleRequest r
                                                        sendEvent o $ WLOutput.EvGeometry geometry
                                                        sendEvent o $ WLOutput.EvDone
                                                        flushEvents
+  | Just (ReqSIGINT)             <- fromRequest r = do c <- interruptedCount <%= (+1)
+                                                       liftIO $ putStrLn $ "Received SIGINT " ++ show c ++ "/3"
+                                                       if c >= 3 then requestTermination else pure ()
   | otherwise                                     = pure ()
 
 main :: IO ()
-main = void $ withDisplay (State M.empty) $ do
+main = void $ withDisplay (State M.empty 0) $ do
   socket <- bindSocket
   liftIO $ putStrLn $ "Listening on socket: " ++ socket
+  registerSignalEvent ReqSIGINT 2
   output <- registerGlobal BindOutput
   processRequests handleRequest
   unregisterGlobal output