--shutdown-ipc FD pattern

ShutdownDemo.hs

module Main where

import Control.Exception
import Control.Concurrent
import Control.Concurrent.Async

import System.Environment
import System.IO
import System.IO.Error

import GHC.IO.Handle.FD (fdToHandle)
import Foreign.C.Types (CInt)

type FD = CInt

main = do
  [fdstr] <- getArgs
  let fd :: FD
      fd = read fdstr
  race_ (waitForEOF fd) app

waitForEOF :: FD -> IO ()
waitForEOF fd = do
    hnd <- fdToHandle fd
    r   <- try $ hGetChar hnd
    case r of
      Left e | isEOFError e -> putStrLn "shutdown" >> return ()
             | otherwise    -> throwIO e
      Right _               -> throwIO (userError "--shutdown-ipc FD does not expect input")

app :: IO ()
app = do
  hSetBuffering stdout NoBuffering
  putChar '.'
  threadDelay 1000000
  app

For example

$ (sleep 10; cat /dev/null) | ./ShutdownDemo 0
..........shutdown

FD 0 is of course stdin, but in general we'd pass an FD of a pipe.