# studentExample.hs -rw-r--r-- 1.1 KiB View raw
                                                                                
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
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (TChan, newTChanIO, readTChan, writeTChan, atomically)

data StudentMethod = SetName String | SetDepartment String | PrintOut

type Student = StudentMethod -> IO ()

newStudent :: String -> String -> IO Student
newStudent initName initDepartment = do
	methodCalls <- newTChanIO
	_ <- forkIO $ studentInternal (atomically $ readTChan methodCalls) initName initDepartment
	return $ (atomically . writeTChan methodCalls)

studentInternal :: IO StudentMethod -> String -> String -> IO ()
studentInternal getNextMethod = next
	where
	next name department = do
		methodCall <- getNextMethod
		handle methodCall name department

	handle (SetName newName) _ department = next newName department
	handle (SetDepartment newDepartment) name _ = next name newDepartment
	handle PrintOut name department = do
		print (name, department)
		next name department

main :: IO ()
main = do
	alice <- newStudent "Alice" "Math"
	bob <- newStudent "Bob" "Math"

	alice PrintOut -- prints ("Alice", "Math")
	bob PrintOut   -- prints ("Bob", "Math")

	bob $ SetName "Joe"
	bob PrintOut   -- prints ("Joe", "Math")