summaryrefslogtreecommitdiff
path: root/ghc/misc/examples/posix/po004/Main.hs
blob: 1725dd4e2b14418ce8c65c1c8793d8fc6b0c6a39 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
import LibPosix
import LibSystem(ExitCode(..), exitWith)

main = 
    forkProcess >>= \ maybe_pid ->
    case maybe_pid of
	Nothing -> raiseSignal floatingPointException
	_ -> doParent

doParent =
    getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->
    case tc of
	Terminated sig | sig == floatingPointException -> forkChild2
	_ -> fail "unexpected termination cause"

forkChild2 =
    forkProcess >>= \ maybe_pid ->
    case maybe_pid of
	Nothing -> exitImmediately (ExitFailure 42)
	_ -> doParent2
    
doParent2 =
    getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->
    case tc of
	Exited (ExitFailure 42) -> forkChild3
	_ -> fail "unexpected termination cause (2)"
	    
forkChild3 =
    forkProcess >>= \ maybe_pid ->
    case maybe_pid of
	Nothing -> exitImmediately (ExitSuccess)
	_ -> doParent3
    
doParent3 =
    getAnyProcessStatus True False >>= \ (Just (pid, tc)) ->
    case tc of
	Exited ExitSuccess -> forkChild4
	_ -> fail "unexpected termination cause (3)"
	    
forkChild4 =
    forkProcess >>= \ maybe_pid ->
    case maybe_pid of
	Nothing -> raiseSignal softwareStop
	_ -> doParent4
    
doParent4 =
    getAnyProcessStatus True True >>= \ (Just (pid, tc)) ->
    case tc of
	Stopped sig | sig == softwareStop -> enoughAlready pid
	_ -> fail "unexpected termination cause (4)"
	    
enoughAlready pid =
    signalProcess killProcess pid >>
    getAnyProcessStatus True True >>= \ (Just (pid, tc)) ->
    case tc of
	Terminated sig | sig == killProcess -> putStr "I'm happy.\n"
	_ -> fail "unexpected termination cause (5)"