Last active
June 24, 2024 17:09
-
-
Save kayvank/01a76a7e2214a3b2ddd3f6540ee604b9 to your computer and use it in GitHub Desktop.
Haskell Signal Handler
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env nix-shell | |
#!nix-shell --pure -p "haskellPackages.ghcWithPackages (pkgs: [])" -i "runghc" | |
{- | |
Installing unix signal handler | |
-} | |
import Control.Concurrent (threadDelay) | |
import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, | |
tryTakeMVar) | |
import System.Posix.Signals (Handler (CatchOnce), installHandler, | |
sigABRT, sigKILL, sigQUIT, sigTERM, sigSTOP) | |
termHandler :: String -> MVar () -> Handler | |
termHandler signalName v = CatchOnce $ do | |
putStrLn $ "Caught " <> signalName | |
putMVar v () | |
loop :: MVar () -> IO () | |
loop v = do | |
putStrLn "Still running" | |
threadDelay 1000000 | |
val <- tryTakeMVar v | |
case val of | |
Just _ -> putStrLn "Quitting" >> pure () | |
Nothing -> loop v | |
main :: IO () | |
main = do | |
v <- newEmptyMVar | |
installHandler sigTERM (termHandler "SIGTERM" v) Nothing | |
installHandler sigSTOP (termHandler "SIGSTOP" v) Nothing | |
installHandler sigQUIT (termHandler "SIGQUIT" v) Nothing | |
installHandler sigABRT (termHandler "SIGABRT" v) Nothing | |
-- | this signal is not catchable. | |
-- See https://hackage.haskell.org/package/unix-2.8.1.1/docs/System-Posix-Signals.html#v:sigKILL | |
installHandler sigKILL (termHandler "SIGKILL" v) Nothing | |
loop v |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment