aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--justfile6
-rw-r--r--specs/Main.hs2
-rw-r--r--specs/Mock.hs54
-rw-r--r--specs/Specs/AppStateUpdateSpec.hs20
-rw-r--r--src/Chelleport.hs4
-rw-r--r--src/Chelleport/Types.hs6
6 files changed, 87 insertions, 5 deletions
diff --git a/justfile b/justfile
index 2df039b..4e4ff2d 100644
--- a/justfile
+++ b/justfile
@@ -4,10 +4,10 @@ default:
run *args:
cabal run chelleport -- {{args}}
-test:
- cabal test
+test *args:
+ cabal test {{args}}
-testw:
+testw *args:
nodemon -e .hs -w src --exec 'ghcid -c "cabal repl test:specs" -T :main'
build:
diff --git a/specs/Main.hs b/specs/Main.hs
index 335407f..5253fb9 100644
--- a/specs/Main.hs
+++ b/specs/Main.hs
@@ -1,8 +1,10 @@
module Main (main) where
+import qualified Specs.AppStateUpdateSpec
import qualified Specs.KeySequenceSpec
import Test.Hspec (hspec)
main :: IO ()
main = hspec $ do
Specs.KeySequenceSpec.test
+ Specs.AppStateUpdateSpec.test
diff --git a/specs/Mock.hs b/specs/Mock.hs
new file mode 100644
index 0000000..7dad452
--- /dev/null
+++ b/specs/Mock.hs
@@ -0,0 +1,54 @@
+module Mock where
+
+import Chelleport.AppShell (MonadAppShell (..))
+import Chelleport.Control (MonadControl (..))
+import Chelleport.Draw (MonadDraw (..))
+import Chelleport.Types
+import Control.Monad (void)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.State (MonadState (get, state), StateT (runStateT), gets)
+import Data.Text (Text)
+import Foreign.C (CInt)
+
+data Call
+ = CallPressMouseButton MouseButtonType
+ | CallMoveMousePosition CInt CInt
+ | CallGetMousePointerPosition
+ | CallHideWindow
+ | CallShowWindow
+ | CallShutdownApp
+ | CallDrawLine (CInt, CInt) (CInt, CInt)
+ | CallDrawText (CInt, CInt) Color Text
+ | CallDrawCircle Int (CInt, CInt)
+ | CallSetDrawColor Color
+ | CallWindowSize
+ deriving (Show, Eq)
+
+newtype MockCalls = MockCalls {calls :: [Call]}
+
+registerMockCall :: (MonadState MockCalls m) => Call -> m ()
+registerMockCall call =
+ void $ state (\mock -> ((), MockCalls {calls = calls mock ++ [call]}))
+
+runWithMocks :: (MonadIO m) => TestM m a -> m (a, MockCalls)
+runWithMocks action = runStateT (runTestM action) (MockCalls [])
+
+newtype TestM m a = TestM {runTestM :: StateT MockCalls m a}
+ deriving (Functor, Applicative, Monad, MonadIO, MonadState MockCalls)
+
+instance (MonadIO m) => MonadControl (TestM m) where
+ pressMouseButton btn = registerMockCall $ CallPressMouseButton btn
+ moveMousePointer x y = registerMockCall $ CallMoveMousePosition x y
+ getMousePointerPosition = (0, 0) <$ registerMockCall CallGetMousePointerPosition
+
+instance (MonadIO m) => MonadDraw (TestM m) where
+ drawLine p1 p2 = registerMockCall $ CallDrawLine p1 p2
+ drawText p color text = (0, 0) <$ registerMockCall (CallDrawText p color text)
+ drawCircle radius p = registerMockCall $ CallDrawCircle radius p
+ setDrawColor color = registerMockCall $ CallSetDrawColor color
+ windowSize = 0 <$ registerMockCall CallWindowSize
+
+instance (MonadIO m) => MonadAppShell (TestM m) where
+ hideWindow = registerMockCall CallHideWindow
+ showWindow = registerMockCall CallShowWindow
+ shutdownApp = registerMockCall CallShutdownApp
diff --git a/specs/Specs/AppStateUpdateSpec.hs b/specs/Specs/AppStateUpdateSpec.hs
new file mode 100644
index 0000000..0b5cac0
--- /dev/null
+++ b/specs/Specs/AppStateUpdateSpec.hs
@@ -0,0 +1,20 @@
+module Specs.AppStateUpdateSpec where
+
+import Chelleport (update)
+import Chelleport.Types
+import Mock
+import Test.Hspec
+
+test = do
+ describe "#update" $ do
+ context "with action TriggerLeftClick" $ do
+ let state = State {stateKeySequence = [], stateIsShiftPressed = False, stateIsMatched = False, stateGrid = []}
+
+ it "hides window and triggers left clicks" $ do
+ (_, mock) <- runWithMocks $ update state TriggerLeftClick
+ calls mock `shouldContain` [CallHideWindow, CallPressMouseButton LeftClick]
+
+ it "continues with action ShutdownApp without updating state" $ do
+ ((state, action), mock) <- runWithMocks $ update state TriggerLeftClick
+ action `shouldBe` Just ShutdownApp
+ state `shouldBe` state
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 2a95a9a..6b443b5 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -11,7 +11,7 @@ import Chelleport.Types
import Chelleport.Utils (intToCInt)
import qualified Chelleport.View
import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Reader (MonadReader, ReaderT (runReaderT))
+import Control.Monad.Reader (ReaderT (runReaderT))
import Data.List ((\\))
import Data.Maybe (fromMaybe, isJust)
import qualified SDL
@@ -66,7 +66,7 @@ eventToAction _state event =
_ -> Nothing
update ::
- (MonadIO m, MonadAppShell m, MonadDraw m, MonadControl m, MonadReader DrawContext m) =>
+ (MonadAppShell m, MonadDraw m, MonadControl m) =>
State ->
AppAction ->
m (State, Maybe AppAction)
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index c1cf386..a6aa7cc 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -1,12 +1,15 @@
module Chelleport.Types where
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
+import Data.Word (Word8)
import qualified Graphics.X11 as X11
import qualified SDL
import qualified SDL.Font as TTF
type Cell = [Char]
+type Color = SDL.V4 Word8
+
type KeySequence = [Char]
type KeyGrid = [[Cell]]
@@ -17,6 +20,7 @@ data State = State
stateIsMatched :: Bool,
stateIsShiftPressed :: Bool
}
+ deriving (Show, Eq)
data AppAction
= HandleKeyInput SDL.Keycode
@@ -26,6 +30,7 @@ data AppAction
| IncrementMouseCursor (Int, Int)
| ShutdownApp
| UpdateShiftState Bool
+ deriving (Show, Eq)
data DrawContext = DrawContext
{ ctxWindow :: SDL.Window,
@@ -43,6 +48,7 @@ type View state = state -> IO ()
type Initializer state = IO state
data MouseButtonType = LeftClick
+ deriving (Show, Eq)
newtype AppM m a = AppM {runAppM :: ReaderT DrawContext m a}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader DrawContext)