ghc/misc/examples/posix/po004/Main.hs

   1 import Posix
   2 import System(ExitCode(..), exitWith)
   3
   4 main =
   5     forkProcess >>= \ maybe_pid ->
   6     case maybe_pid of
   7         Nothing -> raiseSignal floatingPointException
   8         _ -> doParent
   9
  10 doParent =
  11     getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->
  12     case tc of
  13         Terminated sig | sig == floatingPointException -> forkChild2
  14         _ -> fail (userError "unexpected termination cause")
  15
  16 forkChild2 =
  17     forkProcess >>= \ maybe_pid ->
  18     case maybe_pid of
  19         Nothing -> exitImmediately (ExitFailure 42)
  20         _ -> doParent2
  21
  22 doParent2 =
  23     getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->
  24     case tc of
  25         Exited (ExitFailure 42) -> forkChild3
  26         _ -> fail (userError "unexpected termination cause (2)")
  27
  28 forkChild3 =
  29     forkProcess >>= \ maybe_pid ->
  30     case maybe_pid of
  31         Nothing -> exitImmediately (ExitSuccess)
  32         _ -> doParent3
  33
  34 doParent3 =
  35     getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->
  36     case tc of
  37         Exited ExitSuccess -> forkChild4
  38         _ -> fail (userError "unexpected termination cause (3)")
  39
  40 forkChild4 =
  41     forkProcess >>= \ maybe_pid ->
  42     case maybe_pid of
  43         Nothing -> raiseSignal softwareStop
  44         _ -> doParent4
  45
  46 doParent4 =
  47     getAnyProcessStatus True True >>= \ (Just (pid, tc)) ->
  48     case tc of
  49         Stopped sig | sig == softwareStop -> enoughAlready pid
  50         _ -> fail (userError "unexpected termination cause (4)")
  51
  52 enoughAlready pid =
  53     signalProcess killProcess pid >>
  54     getAnyProcessStatus True True >>= \ (Just (pid, tc)) ->
  55     case tc of
  56         Terminated sig | sig == killProcess -> putStr "I'm happy.\n"
  57         _ -> fail (userError "unexpected termination cause (5)")
  58