Big refactoring

1 files changed, 70 insertions, 50 deletions

diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 2bdc6c4..2a95a9a 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -1,22 +1,40 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
 module Chelleport where
 
-import Chelleport.AppShell (Action (AppAction, SysQuit), EventHandler, Update, hideWindow, setupAppShell)
-import Chelleport.Control (currentMousePosition, eventToKeycode, isKeyPress, isKeyPressWith, isKeyReleaseWith, moveMouse, triggerMouseLeftClick)
-import Chelleport.Draw (cellSize)
+import Chelleport.AppShell (MonadAppShell (hideWindow, shutdownApp), setupAppShell)
+import Chelleport.Context (initializeContext)
+import Chelleport.Control (MonadControl (getMousePointerPosition, moveMousePointer, pressMouseButton), directionalIncrement, eventToKeycode, isKeyPress, isKeyPressWith, isKeyReleaseWith)
+import Chelleport.Draw (MonadDraw, cellSize)
 import Chelleport.KeySequence (findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar)
 import Chelleport.Types
-import Chelleport.Utils (cIntToInt, intToCInt)
+import Chelleport.Utils (intToCInt)
 import qualified Chelleport.View
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Reader (MonadReader, ReaderT (runReaderT))
 import Data.List ((\\))
 import Data.Maybe (fromMaybe, isJust)
-import Foreign.C (CInt)
 import qualified SDL
 
-open :: IO ()
-open = setupAppShell initialState update eventToAction Chelleport.View.render
+runEff ::
+  (MonadIO m) =>
+  DrawContext ->
+  AppM m x ->
+  m x
+runEff ctx action = runReaderT (runAppM action) ctx
+
+run :: IO ()
+run = do
+  ctx <- initializeContext
+  setupAppShell
+    ctx
+    (runEff ctx initialState)
+    (\state -> runEff ctx . update state)
+    eventToAction
+    (runEff ctx . Chelleport.View.render)
 
-initialState :: DrawContext -> IO State
-initialState _ctx = do
+initialState :: (MonadIO m) => m State
+initialState = do
   let cells = fromMaybe (pure undefined) $ generateGrid 0 (rows, columns) hintKeys
   pure $
     State
@@ -30,81 +48,83 @@ initialState _ctx = do
     columns = 16
     hintKeys = ['A' .. 'Z'] \\ "Q"
 
-directionalIncrement :: (CInt, CInt) -> Char -> (Int, Int)
-directionalIncrement (incx, incy) = \case
-  'H' -> (-cIntToInt incx, 0)
-  'L' -> (cIntToInt incx, 0)
-  'K' -> (0, -cIntToInt incy)
-  'J' -> (0, cIntToInt incy)
-  _ -> undefined
+eventToAction :: EventHandler State AppAction
+eventToAction _state event =
+  case SDL.eventPayload event of
+    SDL.QuitEvent -> Just ShutdownApp
+    SDL.KeyboardEvent ev
+      | isKeyPressWith ev SDL.KeycodeQ -> Just ShutdownApp
+      | isKeyPressWith ev SDL.KeycodeEscape -> Just ShutdownApp
+      | isKeyPressWith ev SDL.KeycodeSpace -> Just TriggerLeftClick
+      | isKeyPressWith ev SDL.KeycodeTab -> Just ResetKeys
+      | isKeyPress ev && isValidKey (eventToKeycode ev) ->
+          Just $ HandleKeyInput $ eventToKeycode ev
+      | isKeyPressWith ev SDL.KeycodeLShift || isKeyPressWith ev SDL.KeycodeRShift ->
+          Just $ UpdateShiftState True
+      | isKeyReleaseWith ev SDL.KeycodeLShift || isKeyReleaseWith ev SDL.KeycodeRShift ->
+          Just $ UpdateShiftState False
+    _ -> Nothing
 
-update :: Update State AppAction
+update ::
+  (MonadIO m, MonadAppShell m, MonadDraw m, MonadControl m, MonadReader DrawContext m) =>
+  State ->
+  AppAction ->
+  m (State, Maybe AppAction)
 -- Act on key inputs
-update state ctx (FilterSequence key) =
+update state (HandleKeyInput key) = do
   case liftA2 (,) (toKeyChar key) validChars of
     Just (keyChar, validChars')
       | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
           incr <- incrementValue
           let action = IncrementMouseCursor $ directionalIncrement incr keyChar
-          pure (state, Just . AppAction $ action)
+          pure (state, Just action)
       | keyChar `elem` validChars' -> do
           let newKeySequence = stateKeySequence state ++ [keyChar]
           let matchPosition = findMatchPosition newKeySequence $ stateGrid state
           let state' = state {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition}
-          pure (state', AppAction . MoveMousePosition <$> matchPosition)
+          pure (state', MoveMousePosition <$> matchPosition)
     _ -> pure (state, Nothing)
   where
     validChars = nextChars (stateKeySequence state) (stateGrid state)
     incrementValue = do
-      (wcell, hcell) <- cellSize state ctx
+      (wcell, hcell) <- cellSize state
       if stateIsShiftPressed state
         then pure (wcell `div` 4, hcell `div` 4)
         else pure (wcell `div` 16, hcell `div` 16)
 
 -- Move mouse incrementally
-update state ctx (IncrementMouseCursor (incx, incy)) = do
-  (SDL.V2 curx cury) <- currentMousePosition ctx
-  moveMouse ctx (curx + intToCInt incx) (cury + intToCInt incy)
+update state (IncrementMouseCursor (incX, incY)) = do
+  (curX, curY) <- getMousePointerPosition
+  moveMousePointer (curX + intToCInt incX) (curY + intToCInt incY)
   pure (state, Nothing)
 
 -- Move mouse to given position
-update state ctx (MoveMousePosition (row, col)) = do
+update state (MoveMousePosition (row, col)) = do
   (x, y) <- getPosition
-  moveMouse ctx x y
+  moveMousePointer x y
   pure (state, Nothing)
   where
     getPosition = do
-      (wcell, hcell) <- cellSize state ctx
+      (wcell, hcell) <- cellSize state
       let x = (wcell `div` 2) + wcell * intToCInt col
       let y = (hcell `div` 2) + hcell * intToCInt row
       pure (x, y)
 
 -- Reset entered key sequence and state
-update state _ctx ResetKeys = do
+update state ResetKeys = do
   pure (state {stateKeySequence = [], stateIsMatched = False}, Nothing)
 
 -- Trigger left click
-update state ctx TriggerLeftClick = do
-  hideWindow ctx
-  triggerMouseLeftClick ctx
-  pure (state, Just SysQuit)
+update state TriggerLeftClick = do
+  hideWindow
+  pressMouseButton LeftClick
+  pure (state, Just ShutdownApp)
 
--- Set/unset whether shift is pressed
-update state _ctx (UpdateShiftState shift) = pure (state {stateIsShiftPressed = shift}, Nothing)
+-- Cleanup everything and exit
+update state ShutdownApp = do
+  shutdownApp
+  pure (state, Nothing)
 
-eventToAction :: EventHandler State AppAction
-eventToAction _state event =
-  case SDL.eventPayload event of
-    SDL.QuitEvent -> Just SysQuit
-    SDL.KeyboardEvent ev
-      | isKeyPressWith ev SDL.KeycodeQ -> Just SysQuit
-      | isKeyPressWith ev SDL.KeycodeEscape -> Just SysQuit
-      | isKeyPressWith ev SDL.KeycodeSpace -> Just $ AppAction TriggerLeftClick
-      | isKeyPressWith ev SDL.KeycodeTab -> Just $ AppAction ResetKeys
-      | isKeyPress ev && isValidKey (eventToKeycode ev) ->
-          Just . AppAction $ FilterSequence $ eventToKeycode ev
-      | isKeyPressWith ev SDL.KeycodeLShift || isKeyPressWith ev SDL.KeycodeRShift ->
-          Just . AppAction $ UpdateShiftState True
-      | isKeyReleaseWith ev SDL.KeycodeLShift || isKeyReleaseWith ev SDL.KeycodeRShift ->
-          Just . AppAction $ UpdateShiftState False
-    _ -> Nothing
+-- Set/unset whether shift is pressed
+update state (UpdateShiftState shift) =
+  pure (state {stateIsShiftPressed = shift}, Nothing)