Stuff

bluefin-internal/src/Bluefin/Internal.hs

@@ -13,6 +13,7 @@ import qualified Control.Concurrent.Async as Async
 import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Exception (throwIO, tryJust)
 import qualified Control.Exception
+import Control.Monad (when)
 import Control.Monad.Base (MonadBase (liftBase))
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)
@@ -133,27 +134,38 @@ connect1 m1 m2 = unsafeProvideIO $ \io -> do
 
  race (useImplWithin t1) (useImplWithin t2) io
 
-connectExample :: IO String
+connectExample :: IO (Either String String)
 connectExample = runEff $ \io -> do
- connect1
- ( \y -> do
- for_ [1 :: Int .. 10] $ \n -> do
- effIO io (putStrLn ("Sending " ++ show n))
- yield y n
-
- pure "Yielder finished first"
- )
- ( \binit r -> do
- effIO io (putStrLn ("Received initail " ++ show binit))
- for_ [1 :: Int .. 100] $ \n -> do
- b' <- receive r
- effIO
- io
- ( putStrLn
- ("Received body " ++ show b' ++ " at time " ++ show n)
- )
- pure "Receiver finished first"
- )
+ try $ \ex -> do
+ connect1
+ ( \y -> bracket
+ (effIO io (putStrLn "Starting 1"))
+ (\_ -> effIO io (putStrLn "Leaving 1"))
+ $ \_ -> do
+ for_ [1 :: Int .. 10] $ \n -> do
+ effIO io (putStrLn ("Sending " ++ show n))
+ yield y n
+ when (n > 5) $ do
+ effIO io (putStrLn "Aborting...")
+ throw ex "Aborted"
+
+ pure "Yielder finished first"
+ )
+ ( \binit r ->
+ bracket
+ (effIO io (putStrLn "Starting 2"))
+ (\_ -> effIO io (putStrLn "Leaving 2"))
+ $ \_ -> do
+ effIO io (putStrLn ("Received intial " ++ show binit))
+ for_ [1 :: Int .. 100] $ \n -> do
+ b' <- receive r
+ effIO
+ io
+ ( putStrLn
+ ("Received body " ++ show b' ++ " at time " ++ show n)
+ )
+ pure "Receiver finished first"
+ )
 
 instance (e :> es) => MonadBase IO (EffReader (IOE e) es) where
  liftBase = liftIO