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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
-- based on
-- https://stackoverflow.com/questions/4522387/how-can-i-emulate-gos-channels-with-haskell
-- but this version encodes end-of-stream on the communication channel, as a Nothing
module Control.Concurrent.Go
( chan
, readCh
, (-<-)
, writeCh
, (->-)
, go
)
where
import Control.Concurrent ( forkIO
, ThreadId
, threadDelay
)
import Control.Concurrent.STM.TChan ( newTChan
, readTChan
, writeTChan
, isEmptyTChan
, TChan
)
import Control.Monad ( forM_ )
import GHC.Conc ( atomically )
-- | Make a new channel.
chan :: _
chan = atomically . newTChan
-- | Take from a channel.
readCh :: TChan a -> IO a
readCh = atomically . readTChan
-- | Alias for 'readCh'.
--
-- >>> c <- chan
-- >>> writeCh c "val"
-- >>> -<- c
-- "val"
--
-- I don't think this looks terrible with do-notation:
--
-- >>> c <- chan
-- >>> writeCh c "val"
-- >>> result <- -<- c
-- >>> print result
-- "val"
(-<-) :: TChan a -> IO a
(-<-) = readCh
-- | Write to a channel.
writeCh :: TChan a -> a -> IO ()
writeCh ch v = atomically $ writeTChan ch v
-- | Alias for 'writeCh', but flipped to make it read better.
--
-- >>> c <- chan
-- >>> "val" ->- c
-- >>> readCh c
-- "val"
(->-) :: TChan a -> a -> IO ()
(->-) = flip writeCh
-- | Starts a background process.
go :: IO () -> IO ThreadId
go = forkIO
{- Example: (TODO: move to module-level docs)
-- can I just implement forM/Traversable over the channel?
forRange :: TChan (Maybe a) -> (a -> IO b) -> IO [b]
forRange ch fn = helper fn [] where
-- helper :: (a -> IO b) -> [b] -> IO [b]
helper fn acc = do
jv <- readCh ch
case jv of
Nothing -> return $ reverse acc
Just v -> do
b <- fn v
helper fn (b : acc)
feedData :: (Num a, Enum a) => TChan (Maybe a) -> IO ()
feedData ch = do
forM_ [1 .. 9999] (\x -> writeCh ch (Just x))
writeQ ch Nothing -- EOF value
printData :: TChan (Maybe Int) -> IO ()
printData c = do
forRange c (print :: Int -> IO ())
return ()
main :: IO ()
main = do
ch <- chan
go $ feedData ch
printData ch
-}
|
