Commit before attempting to add concurrency to loop

src/Loop.hs

@@ -1,77 +1,91 @@
 --{-# LANGUAGE TupleSections #-}
+
 {- |
 Module      : Loop
 Description : Simple game loop
 
 This module sets up an SDL window which may be updated using a simple game loop.
 -}
-module Loop
-    ( setupLoop
-    ) where
-import qualified Data.Text as T
+module Loop (
+    setupLoop,
+) where
+
 import Control.Concurrent
 import Control.Exception
 import Control.Monad
-import System.Mem
-import SDL
+import qualified Data.Text as T
 import qualified Graphics.Rendering.OpenGL as GL
+import SDL
+import System.Mem
+
 -- | Create a game loop with an SDL window.
-setupLoop
-    :: Int                  -- ^ Target seconds per frame
-    -> T.Text               -- ^ Window title
-    -> WindowConfig
-    -> (world -> IO ())    -- ^ Function for cleaning up parameters, applied when exiting loop.
-    -> IO world             -- ^ Initial simulation state.
-    -> (world -> IO world)   -- ^ update, called once per frame. Allows for side effects such as rendering.
-    -> (world -> Event -> IO (Maybe world))
-                            -- ^ SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
-    -> IO ()
-setupLoop spf title winconfig paramCleanup ioStartWorld sideEffects eventFn = do 
+setupLoop ::
+    -- | Target seconds per frame
+    Int ->
+    -- | Window title
+    T.Text ->
+    WindowConfig ->
+    -- | Function for cleaning up parameters, applied when exiting loop.
+    (world -> IO ()) ->
+    -- | Initial simulation state.
+    IO world ->
+    -- | update, called once per frame. Allows for side effects such as rendering.
+    (world -> IO world) ->
+    -- | SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
+    (world -> Event -> IO (Maybe world)) ->
+    IO ()
+setupLoop spf title winconfig paramCleanup ioStartWorld sideEffects eventFn = do
     initializeAll
-    bracket 
-        (createWindow title winconfig) 
-        destroyWindow 
-        $ \window -> bracket 
-            (glCreateContext window) 
-            ( \con -> GL.finish >> glDeleteContext con)
-            $ \_   -> bracket 
-                ioStartWorld
-                paramCleanup 
-                (doLoop spf window sideEffects eventFn)
+    bracket
+        (createWindow title winconfig)
+        destroyWindow
+        $ \window -> bracket
+            (glCreateContext window)
+            (\con -> GL.finish >> glDeleteContext con)
+            $ \_ ->
+                bracket
+                    ioStartWorld
+                    paramCleanup
+                    (doLoop spf window sideEffects eventFn)
+
 -- | The internal loop.
-doLoop
-    :: Int      -- ^ target msec per frame
-    -> Window   -- ^ The SDL window.
-    -> (world -> IO world) -- ^ simulation update. 
-    -> (world -> Event -> IO (Maybe world)) -- ^ SDL Event handling.
-    -> world    -- ^ Current simulation state.
-    -> IO ()
+doLoop ::
+    -- | target msec per frame
+    Int ->
+    -- | The SDL window.
+    Window ->
+    -- | simulation update.
+    (world -> IO world) ->
+    -- | SDL Event handling.
+    (world -> Event -> IO (Maybe world)) ->
+    -- | Current simulation state.
+    world ->
+    IO ()
 doLoop spf window worldSideEffects eventFn startWorld = do
     startTicks <- ticks
     worldAfterSimStep <- worldSideEffects startWorld
     glSwapWindow window
     maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep)
     case maybeUpdatedWorld of
-        Just updatedWorld -> do 
+        Just updatedWorld -> do
             performGC
             endTicks <- ticks -- it might be better to use System.Clock (monotonic)
-
             let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
-            threadDelay (theDelay * 1000 )
-
+            threadDelay (theDelay * 1000)
             doLoop spf window worldSideEffects eventFn updatedWorld
         Nothing -> return ()
 
--- | Handle quit events in a manner to exit the loop. Other events handled as
--- determined by the custom function, although resize events also change the viewport.
+{- | Handle quit events in a manner to exit the loop. Other events handled as
+ determined by the custom function, although resize events also change the viewport.
+-}
 applyEventIO :: (world -> Event -> IO (Maybe world)) -> Maybe world -> Event -> IO (Maybe world)
 applyEventIO fn mw e = case eventPayload e of
-    QuitEvent           -> return Nothing
+    QuitEvent -> return Nothing
     WindowClosedEvent _ -> return Nothing
-    WindowSizeChangedEvent WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y}
-                        -> (GL.viewport $= (GL.Position 0 0,GL.Size x y)) >> mupdate
-    _                   -> mupdate
+    WindowSizeChangedEvent WindowSizeChangedEventData{windowSizeChangedEventSize = V2 x y} ->
+        (GL.viewport $= (GL.Position 0 0, GL.Size x y)) >> mupdate
+    _ -> mupdate
   where
     mupdate = case mw of
         Nothing -> return Nothing
-        Just w  -> fn w e
+        Just w -> fn w e