@@ -5,11 +5,11 @@
55
66import Streamly
77import Streamly.Prelude as S
8−import Control.Monad (when)
8+import Control.Monad (void, when)
99import Control.Monad.IO.Class (MonadIO(liftIO))
1010import Control.Monad.State (MonadState, get, modify, runStateT, put)
1111
12−data Event = Harm Int | Heal Int deriving (Show)
12+data Event = Quit | Harm Int | Heal Int deriving (Show)
1313
1414userAction :: MonadAsync m => SerialT m Event
1515userAction = S.repeatM $ liftIO askUser
@@ -18,26 +18,34 @@ userAction = S.repeatM $ liftIO askUser
1818 command <- getLine
1919 case command of
2020 "potion" -> return (Heal 10)
21− "quit" -> fail "quit"
22− _ -> putStrLn "What?" >> askUser
21+ "harm" -> return (Harm 10)
22+ "quit" -> return Quit
23+ _ -> putStrLn "Type potion or harm or quit" >> askUser
2324
2425acidRain :: MonadAsync m => SerialT m Event
2526acidRain = asyncly $ constRate 1 $ S.repeatM $ liftIO $ return $ Harm 1
2627
27−game :: (MonadAsync m, MonadState Int m) => SerialT m ()
28−game = do
28+data Status = Check | Done
29+
30+processEvents :: (MonadAsync m, MonadState Int m) => SerialT m Status
31+processEvents = do
2932 event <- userAction `parallel` acidRain
3033 case event of
31− Harm n -> modify $ \h -> h - n
32− Heal n -> modify $ \h -> h + n
33−
34− h <- get
35− when (h <= 0) $ fail "You die!"
36− liftIO $ putStrLn $ "Health = " <> show h
34+ Harm n -> modify (\h -> h - n) >> return Check
35+ Heal n -> modify (\h -> h + n) >> return Check
36+ Quit -> return Done
37+
38+checkStatus status =
39+ case status of
40+ Done -> liftIO $ putStrLn "You quit!" >> return False
41+ Check -> do
42+ h <- get
43+ liftIO $ if (h <= 0)
44+ then putStrLn "You die!" >> return False
45+ else putStrLn ("Health = " <> show h) >> return True
3746
3847main :: IO ()
3948main = do
4049 putStrLn "Your health is deteriorating due to acid rain,\
4150 \ type \"potion\" or \"quit\""
42− _ <- runStateT (runStream game) 60
43− return ()
51+ void $ runStateT (S.any (== False) $ S.mapM checkStatus $ processEvents) 60