summaryrefslogtreecommitdiff
path: root/examples/Main.hs
blob: 470e24606831272e892033f5fc5d4aaef60c437b (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
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Control.Concurrent.Supervisor
import Control.Concurrent
import Control.Exception
import Control.Concurrent.STM

job1 :: IO ()
job1 = do
  threadDelay 5000000
  fail "Dead"

job2 :: ThreadId -> IO ()
job2 tid = do
  threadDelay 3000000
  killThread tid

job3 :: IO ()
job3 = do
  threadDelay 5000000
  error "Oh boy, I'm good as dead"

job4 :: IO ()
job4 = threadDelay 7000000

job5 :: IO ()
job5 = threadDelay 100 >> error "dead"

main :: IO ()
main = bracketOnError (do
  supSpec <- newSupervisorSpec

  sup1 <- newSupervisor supSpec
  sup2 <- newSupervisor supSpec

  sup1 `monitor` sup2

  _ <- forkSupervised sup2 oneForOne job3

  j1 <- forkSupervised sup1 oneForOne job1
  _ <- forkSupervised sup1 oneForOne (job2 j1)
  _ <- forkSupervised sup1 oneForOne job4
  _ <- forkSupervised sup1 oneForOne job5
  _ <- forkIO (go (eventStream sup1))
  return sup1) shutdownSupervisor (\_ -> threadDelay 10000000000)
  where
   go eS = do
     newE <- atomically $ readTBQueue eS
     print newE
     go eS