git.iko.soy/streamly
on bcf4b0e help sign in
streamly/src/Streamly/Examples/AcidRainGame.hs
46 lines 1.4 kB history raw
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
6module Streamly.Examples.AcidRainGame where
8import Streamly
9import Control.Concurrent (threadDelay)
10import Control.Monad (when)
11import Control.Monad.State (MonadState, get, modify, runStateT)
12import Data.Semigroup (cycle1)
14data Event = Harm Int | Heal Int | Quit deriving (Show)
16userAction :: MonadIO m => StreamT m Event
17userAction = cycle1 $ liftIO askUser
18 where
19 askUser = do
20 command <- getLine
21 case command of
22 "potion" -> return (Heal 10)
23 "quit" -> return Quit
24 _ -> putStrLn "What?" >> askUser
26acidRain :: MonadIO m => StreamT m Event
27acidRain = cycle1 $ liftIO (threadDelay 1000000) >> return (Harm 1)
29game :: (MonadAsync m, MonadState Int m) => StreamT m ()
30game = do
31 event <- userAction <|> acidRain
32 case event of
33 Harm n -> modify $ \h -> h - n
34 Heal n -> modify $ \h -> h + n
35 Quit -> fail "quit"
37 h <- get
38 when (h <= 0) $ fail "You die!"
39 liftIO $ putStrLn $ "Health = " ++ show h
41acidRainGame :: IO ()
42acidRainGame = do
43 putStrLn "Your health is deteriorating due to acid rain,\
44 \ type \"potion\" or \"quit\""
45 _ <- runStateT (runStreamT game) 60
46 return ()