git.iko.soy/streamly
on 5054813 help sign in
streamly/examples/AcidRain.hs
58 lines 2.0 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
3-- Copyright : (c) 2017 Harendra Kumar
4-- (c) 2013, 2014 Gabriel Gonzalez
5--
6-- This example is adapted from Gabriel Gonzalez's pipes-concurrency package.
7-- https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html
9import Streamly
10import Streamly.Prelude as S
11import Control.Monad (void)
12import Control.Monad.IO.Class (MonadIO(liftIO))
13import Control.Monad.State (MonadState, get, modify, runStateT)
15data Event = Quit | Harm Int | Heal Int deriving (Show)
17userAction :: MonadAsync m => SerialT m Event
18userAction = S.repeatM $ liftIO askUser
19 where
20 askUser = do
21 command <- getLine
22 case command of
23 "potion" -> return (Heal 10)
24 "harm" -> return (Harm 10)
25 "quit" -> return Quit
26 _ -> putStrLn "Type potion or harm or quit" >> askUser
28acidRain :: MonadAsync m => SerialT m Event
29acidRain = asyncly $ constRate 1 $ S.repeatM $ liftIO $ return $ Harm 1
31data Result = Check | Done
33runEvents :: (MonadAsync m, MonadState Int m) => SerialT m Result
34runEvents = do
35 event <- userAction `parallel` acidRain
36 case event of
37 Harm n -> modify (\h -> h - n) >> return Check
38 Heal n -> modify (\h -> h + n) >> return Check
39 Quit -> return Done
41data Status = Alive | GameOver deriving Eq
43getStatus :: (MonadAsync m, MonadState Int m) => Result -> m Status
44getStatus result =
45 case result of
46 Done -> liftIO $ putStrLn "You quit!" >> return GameOver
47 Check -> do
48 h <- get
49 liftIO $ if (h <= 0)
50 then putStrLn "You die!" >> return GameOver
51 else putStrLn ("Health = " <> show h) >> return Alive
53main :: IO ()
54main = do
55 putStrLn "Your health is deteriorating due to acid rain,\
56 \ type \"potion\" or \"quit\""
57 let runGame = S.drainWhile (== Alive) $ S.mapM getStatus runEvents
58 void $ runStateT runGame 60