coroutine: generator example

generator coroutine example

{-# LANGUAGE FlexibleContexts #-}

module Main where

import Data.Functor.Identity (Identity(..))
import Control.Monad.Coroutine 
import Control.Monad.Trans
import Control.Concurrent hiding (yield)

import Data.IORef

type Generator a m x = Coroutine ((,) a) m x

yield :: (Monad m, Functor ((,) x)) => x -> Generator x m () 
yield x = suspend (x, return ())

runGenerator :: Monad m => Generator x m r -> m ([x],r)
runGenerator = run' id where
  run' f g = resume g
    >>= either (\(x,cont) -> run' (f . (x:)) cont)
               (\r -> return (f [], r))

gen :: Generator Int IO Int   
gen = do lift (putStr "Yielding one, ") 
         yield 1
         lift (putStr "then two, ")
         yield 2 
         lift (putStr "return three: ") 
         return 3 

main = do 
  putStrLn "generator test"
  r <- runGenerator gen 
  print r 
  --
  -- eventprocessor atestcallback 

  gref <- newIORef gen 
  eventprocessor (bouncecallback gref)


atestcallback :: IO () 
atestcallback = do 
  putStrLn "I am event processor"


bouncecallback :: IORef (Generator Int IO Int) ->  IO () 
bouncecallback gref = do 
  gen <- readIORef gref 
  r <- resume gen
  case r of  
    Left (n,gen') -> writeIORef gref gen' 
    Right val -> putStrLn $ show val 
  putStrLn "one step"
  return ()  


{-
bouncecallback :: IORef (Coroutine s m x) ->  IO () 
bouncecallback gref = do 
  gen <- readIORef gref 
  r <- resume gen
  case r of  
    Left (n,gen') -> writeIORef gref gen' 
    Right val -> putStrLn $ show val 
  putStrLn "one step"
  return ()  
-}


eventprocessor :: IO () -> IO () 
eventprocessor callback = do 
  -- putStrLn "I am event processor" 
  threadDelay 5000000
  callback 
  eventprocessor callback