Separate key-getting function from event handler

src/Game/Engine.hs

@@ -4,9 +4,11 @@
 
 module Game.Engine where
 
+import Control.Monad (guard)
 import Control.Monad.Trans.MSF.Maybe
 import Control.Monad.Trans.MSF.Reader
 import Control.Monad.Trans.MSF.Writer
+import Data.Functor (($>))
 import Data.Maybe
 import Data.MonadicStreamFunction
 import Game.Display
@@ -15,22 +17,30 @@ import Game.Utils
 import Graphics.Gloss
 import Graphics.Gloss.Interface.IO.Game
 
-handleEvents :: Monad m => MSF (DrawerT m) () [Direction]
+-- * Input handling
-handleEvents = mapMaybe getDir <$> liftTransS (constM ask)
+
+getKeys :: Monad m => MSF (DrawerT m) () [Key]
+getKeys = mapMaybe getKey <$> liftTransS (constM ask)
   where
-    getDir :: Event -> Maybe Direction
+    getKey :: Event -> Maybe Key
-    getDir (EventKey k Down _ _) = case k of
+    getKey (EventKey k Down _ _) = Just k
-      Char 'w' -> Just U
+    getKey _ = Nothing
-      Char 's' -> Just D
+
-      Char 'a' -> Just L
+handleEvents :: Monad m => MSF (DrawerT m) () [Direction]
-      Char 'd' -> Just R
+handleEvents = mapMaybe getDir <$> getKeys
-      SpecialKey KeyUp -> Just U
+  where
-      SpecialKey KeyDown -> Just D
+    getDir :: Key -> Maybe Direction
-      SpecialKey KeyLeft -> Just L
+    getDir (Char 'w') = Just U
-      SpecialKey KeyRight -> Just R
+    getDir (Char 's') = Just D
-      _ -> Nothing
+    getDir (Char 'a') = Just L
+    getDir (Char 'd') = Just R
+    getDir (SpecialKey KeyUp) = Just U
+    getDir (SpecialKey KeyDown) = Just D
+    getDir (SpecialKey KeyLeft) = Just L
+    getDir (SpecialKey KeyRight) = Just R
     getDir _ = Nothing
 
+-- * Core game engine
 
 tickState :: Maybe Direction -> GameState -> Maybe GameState
 tickState dir state =