Haskell game loop with keyboard handler

Question

This is function, that works correctly, but it seems to be too ugly. panel argument is never used for anything but pushing into refreshGamePanel, and it seems to be too much case statements. How can I cleanup this?

runGameLoop :: Game -> Panel -> Curses GameResult
runGameLoop game panel
 = if victory game then return Victory else
 refreshGamePanel game panel >> render >> getPanelWindow panel >>=
 flip getEvent (Just 1)
 >>=
 \ event' ->
 case event' of
 Nothing -> runGameLoop game panel
 Just event -> case event of
 EventSpecialKey (KeyFunction 2) -> return Restart
 EventSpecialKey (KeyFunction 10) -> return Quit
 EventSpecialKey key' -> case keyToDirection key' of
 Nothing -> runGameLoop game panel
 Just dir -> runGameLoop (makeMove game dir) panel
 _ -> runGameLoop game panel

• Landei: Did you try to use do notation? Further, look for more idiomatic ways to deal with Maybe (how about fromMaybe ?).

Answer 1

There is a nice language extension in GHC called ViewPatterns. Together with LambdaCase that fature allows you to shorten your code, I think. And do notation will be much more readable for imperative part.

runGameLoop game panel | victory game = return Victory
 | otherwise = continue
 where
 anyEvent = gatPanelWindow panel >>= flip getEvent (Just 1)
 isRestart = (EventSpecialKey (KeyFunction 2) ==)
 isQuit = (EventSpecialKey (KeyFunction 10) ==)
 continue = do
 refreshGamePanel game panel
 render
 anyEvent >>= \case
 Just (isRestart -> True) -> return Restart
 Just (isQuit -> True) -> return Quit
 Just (EventSpecialKey (keyToDirection -> Just dir)) ->
 runGameLoop (makeMove game dir) panel
 _ -> runGameLoop game panel

Another variant is to consider using of Monad Maybe instance

runGameLoop game panel = nextStep where
 anyEvent = gatPanelWindow panel >>= flip getEvent (Just 1)
 nextStep = if victory game then return Victory else do
 refreshGamePanel game panel
 render
 liftM react anyEvent >>= \case
 Just continuation -> continuation
 Nothing -> runGameLoop game panel
 react event' = do
 event' >>= \case
 EventSpecialKey (KeyFunction 2) -> return (return Restart)
 EventSpecialKey (KeyFunction 10) -> return (return Quit)
 EventSpecialKey key -> do
 dir <- keyToDirection key
 return (runGameLoop (makeMove game dir) panel)
 _ -> Nothing