1 files changed, 34 insertions, 54 deletions

diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 897af83..e8cd3ab 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -1,78 +1,58 @@
 module Chelleport.AppShell where
 
-import Chelleport.Context (initializeContext)
 import Chelleport.Draw (colorBackground)
 import Chelleport.Types
-import Control.Monad (foldM, unless)
+import Control.Monad (foldM)
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Control.Monad.RWS (MonadReader (ask))
 import qualified Graphics.X11 as X11
 import SDL (($=))
 import qualified SDL
-import qualified SDL.Font as TTF
 import System.Exit (exitSuccess)
 
-data Action act = SysQuit | AppAction act
+class (Monad m) => MonadAppShell m where
+  hideWindow :: m ()
+  showWindow :: m ()
+  shutdownApp :: m ()
 
-newtype SysState = SysState {sysExit :: Bool}
-
-type Update state appAction = state -> DrawContext -> appAction -> IO (state, Maybe (Action appAction))
-
-type EventHandler state appAction = state -> SDL.Event -> Maybe (Action appAction)
-
-type View state = state -> DrawContext -> IO ()
-
-type Initializer state = DrawContext -> IO state
+instance (MonadIO m) => MonadAppShell (AppM m) where
+  hideWindow = ask >>= SDL.hideWindow . ctxWindow
+  showWindow = ask >>= SDL.showWindow . ctxWindow
+  shutdownApp = do
+    ctx <- ask
+    SDL.destroyRenderer $ ctxRenderer ctx
+    SDL.destroyWindow $ ctxWindow ctx
+    liftIO $ do
+      X11.closeDisplay $ ctxX11Display ctx
+      exitSuccess
 
 setupAppShell ::
-  -- forall state appAction.
+  DrawContext ->
   Initializer state ->
   Update state appAction ->
   EventHandler state appAction ->
   View state ->
   IO ()
-setupAppShell initState update eventHandler draw = do
-  -- Initialize SDL
-  SDL.initializeAll
-  TTF.initialize
-  ctx <- initializeContext
-  state <- initState ctx
-
-  appLoop ctx (state, SysState {sysExit = False})
-
-  shutdownApp ctx
+setupAppShell ctx initState update eventHandler draw = do
+  state <- initState
+  appLoop state
   where
-    appLoop drawCtx (state, sysState) = do
-      SDL.rendererDrawColor (ctxRenderer drawCtx) $= colorBackground
-      SDL.clear $ ctxRenderer drawCtx
-      draw state drawCtx
-      SDL.present $ ctxRenderer drawCtx
+    appLoop state = do
+      SDL.rendererDrawColor (ctxRenderer ctx) $= colorBackground
+      SDL.clear $ ctxRenderer ctx
+      draw state
+      SDL.present $ ctxRenderer ctx
 
       events <- SDL.pollEvents
+      newState <- foldM evaluateEvent state events
 
-      (newState, newSysState) <- foldM (evaluateEvent drawCtx) (state, sysState) events
-
-      unless (sysExit newSysState) $
-        appLoop drawCtx (newState, newSysState)
-
-    evaluateEvent drawCtx stTup event =
-      maybe (pure stTup) (updateState drawCtx stTup) (eventHandler (fst stTup) event)
-
-    evalUpdateResult _drawCtx sysState (state, Nothing) = pure (state, sysState)
-    evalUpdateResult drawCtx sysState (state, Just action) = updateState drawCtx (state, sysState) action
-
-    updateState _ (state, sysState) SysQuit = pure (state, sysState {sysExit = True})
-    updateState drawCtx (state, sysState) (AppAction action) =
-      update state drawCtx action >>= evalUpdateResult drawCtx sysState
+      appLoop newState
 
-hideWindow :: DrawContext -> IO ()
-hideWindow ctx = SDL.hideWindow (ctxWindow ctx)
+    evaluateEvent state event =
+      maybe (pure state) (updateState state) (eventHandler state event)
 
-closeWindow :: DrawContext -> IO ()
-closeWindow ctx = do
-  SDL.destroyRenderer $ ctxRenderer ctx
-  SDL.destroyWindow $ ctxWindow ctx
+    updateState state action =
+      update state action >>= evalUpdateResult
 
-shutdownApp :: DrawContext -> IO ()
-shutdownApp ctx = do
-  closeWindow ctx
-  X11.closeDisplay $ ctxX11Display ctx
-  exitSuccess
+    evalUpdateResult (state, Nothing) = pure state
+    evalUpdateResult (state, Just action) = updateState state action