-- 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 -- I could not get Intero or ghc to accept a type-annotation for the helper function, -- even using the exact inferred type from Intero. -- 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 -}