@@ -0,0 +1,42 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+
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
5+
6+import Asyncly
7+import Control.Concurrent (threadDelay)
8+import Control.Monad (when)
9+import Control.Monad.State
10+import Data.Foldable (fold)
11+
12+data Event = Harm Int | Heal Int | Quit deriving (Show)
13+
14+userAction :: MonadIO m => AsyncT m Event
15+userAction = fold $ repeat $ liftIO $ askUser
16+ where
17+ askUser = do
18+ command <- getLine
19+ case command of
20+ "potion" -> return (Heal 10)
21+ "quit" -> return Quit
22+ _ -> putStrLn "What?" >> askUser
23+
24+acidRain :: MonadIO m => AsyncT m Event
25+acidRain = fold $ repeat $ liftIO (threadDelay 1000000) >> return (Harm 1)
26+
27+game :: (MonadAsync m, MonadState Int m) => AsyncT m ()
28+game = do
29+ event <- userAction <|> acidRain
30+ case event of
31+ Harm n -> modify $ \h -> h - n
32+ Heal n -> modify $ \h -> h + n
33+ Quit -> error "quit"
34+
35+ h <- get
36+ when (h <= 0) $ error "You die!"
37+ liftIO $ putStrLn $ "Health = " ++ show h
38+
39+main = do
40+ putStrLn "Your health is deteriorating due to acid rain,\
41+ \ type \"potion\" or \"quit\""
42+ runStateT (runAsyncly game) 60