@@ -0,0 +1,42 @@
1+{-# LANGUAGE FlexibleContexts #-}
3+-- This example is adapted from Gabriel Gonzalez's pipes-concurrency package.
4+-- https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html
7+import Control.Concurrent (threadDelay)
8+import Control.Monad (when)
9+import Control.Monad.State
10+import Data.Foldable (fold)
12+data Event = Harm Int | Heal Int | Quit deriving (Show)
14+userAction :: MonadIO m => AsyncT m Event
15+userAction = fold $ repeat $ liftIO $ askUser
20+ "potion" -> return (Heal 10)
21+ "quit" -> return Quit
22+ _ -> putStrLn "What?" >> askUser
24+acidRain :: MonadIO m => AsyncT m Event
25+acidRain = fold $ repeat $ liftIO (threadDelay 1000000) >> return (Harm 1)
27+game :: (MonadAsync m, MonadState Int m) => AsyncT m ()
29+ event <- userAction <|> acidRain
31+ Harm n -> modify $ \h -> h - n
32+ Heal n -> modify $ \h -> h + n
36+ when (h <= 0) $ error "You die!"
37+ liftIO $ putStrLn $ "Health = " ++ show h
40+ putStrLn "Your health is deteriorating due to acid rain,\
41+ \ type \"potion\" or \"quit\""
42+ runStateT (runAsyncly game) 60