Warp signal handling

warp-signal.hs

{-# LANGUAGE OverloadedStrings #-}
import Network.Wai (responseLBS)
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (status200)
import System.Posix.Signals (sigINT, installHandler, Handler (CatchOnce))
import Control.Concurrent (forkIO, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)

app _ = return $ responseLBS status200 [] "foo"

main = do
    flag <- newEmptyMVar
    tid <- forkIO $ run 3000 app
    installHandler sigINT (CatchOnce $ do
        putStrLn "Caught an interrupt"
        killThread tid
        putMVar flag ()) Nothing
    takeMVar flag
    putStrLn "Warp exited"