santa

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
module Main (main) where

import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
import System.Random

data Species a = Reindeer [a] | Elves [a]

main = do
  (toRobin,fromRobin) <- secretary 9 Reindeer
  (toEdna,fromEdna) <- secretary 3 Elves
  sequence [ spawnWorker (atomically . toRobin) "Reindeer " i " delivering toys."
           | i <- [1..9] ]
  sequence [ spawnWorker (atomically . toEdna) "Elf " i " meeting in the study."
           | i <- [1..10] ]
  newChan >>= santa (atomically (fromRobin `orElse` fromEdna)) -- main thread is santa's

secretary count species = do
  chan <- newTChanIO
  return (writeTChan chan,fmap species (replicateM count (readTChan chan)))

santa getNext self = forever (getNext >>= handle) where
  handle (Reindeer group) = do putStrLn "Ho, ho, ho!  Let's deliver toys!"
                               act group
  handle (Elves group)    = do putStrLn "Ho, ho, ho!  Let's meet in the study!"
                               act group
  act group = do sequence_ [tellMember (writeChan self ()) | tellMember <- group]
                 replicateM_ (length group) (readChan self)

spawnWorker tellSecretary before i after =
  forkIO (newChan >>= worker tellSecretary (before ++ show i ++ after))

worker tellSecretary msg self = forever $ do
  threadDelay =<< randomRIO (0,1000*1000) -- 0 to 1 second
  tellSecretary (writeChan self)
  tellGateKeeperIamDone <- readChan self
  putStrLn msg
  tellGateKeeperIamDone
13:3: Error: Use sequence_
Found:
sequence
[spawnWorker (atomically . toRobin) "Reindeer " i
" delivering toys."
| i <- [1 .. 9]]
Why not:
sequence_
[spawnWorker (atomically . toRobin) "Reindeer " i
" delivering toys."
| i <- [1 .. 9]]
15:3: Error: Use sequence_
Found:
sequence
[spawnWorker (atomically . toEdna) "Elf " i
" meeting in the study."
| i <- [1 .. 10]]
Why not:
sequence_
[spawnWorker (atomically . toEdna) "Elf " i
" meeting in the study."
| i <- [1 .. 10]]