Add actions and implement select square action

optics!

numbersquare.cabal

@@ -18,6 +18,7 @@ build-type:     Simple
 library
   exposed-modules:
       Game
+      Types.BoardAction
       Types.BoardPosition
       Types.GameBoard
       Types.GameMode
@@ -34,6 +35,9 @@ library
       MultiParamTypeClasses
       TypeFamilies
       UndecidableInstances
+      OverloadedLabels
+      NamedFieldPuns
+      TypeOperators
   ghc-options: -Wall
   build-depends:
       array
@@ -61,6 +65,9 @@ executable numbersquare
       MultiParamTypeClasses
       TypeFamilies
       UndecidableInstances
+      OverloadedLabels
+      NamedFieldPuns
+      TypeOperators
   ghc-options: -Wall
   build-depends:
       array
@@ -90,6 +97,9 @@ test-suite numberspec-test
       MultiParamTypeClasses
       TypeFamilies
       UndecidableInstances
+      OverloadedLabels
+      NamedFieldPuns
+      TypeOperators
   ghc-options: -Wall -threaded -O0
   build-depends:
       QuickCheck

package.yaml

@@ -27,6 +27,9 @@ default-extensions:
   - MultiParamTypeClasses
   - TypeFamilies
   - UndecidableInstances
+  - OverloadedLabels
+  - NamedFieldPuns
+  - TypeOperators
 
 library:
   source-dirs:

src/Types/BoardAction.hs

@@ -0,0 +1,6 @@
+module Types.BoardAction where
+
+import Types.BoardPosition
+
+data BoardAction = SelectSquare {topLeft :: BoardPosition, bottomRight :: BoardPosition}
+    deriving (Show, Eq)

src/Types/GameMode.hs

@@ -8,6 +8,7 @@ import Data.Bifunctor (Bifunctor (first))
 import Data.Kind (Type)
 import Display
 import System.Random.Stateful (Random (randomR), RandomGen)
+import Types.BoardPosition
 
 {- | The type of game that is being played.
 

src/Types/GameState.hs

@@ -4,10 +4,11 @@ module Types.GameState where
 
 import Data.Sequence (Seq)
 import Data.Sequence qualified as S
-import Optics (makeFieldLabels)
+import Optics
 import System.Random
+import Types.BoardAction
 import Types.GameBoard
-import Types.GameMode (GameMode)
+import Types.GameMode
 import Types.Player
 
 data GameState mode = MkGameState
@@ -15,7 +16,7 @@ data GameState mode = MkGameState
     , players :: Seq PlayerState
     }
 
-makeFieldLabels ''GameState
+makeFieldLabelsNoPrefix ''GameState
 
 newtype PlayerIndex = MkPlayerIndex Int
     deriving (Show, Eq)
@@ -25,3 +26,12 @@ newGame gmode playerInfos rng =
     let (initialBoard, nextRng) = newRandomBoard gmode 10 10 rng
         playerStates = S.fromList $ map (\n -> MkPlayerState{name = n, score = 0}) playerInfos
      in (MkGameState initialBoard playerStates, nextRng)
+
+makeMove :: (GameMode mode) => PlayerIndex -> BoardAction -> GameState mode -> GameState mode
+makeMove (MkPlayerIndex idx) (SelectSquare topLeft bottomRight) state@MkGameState{board} =
+    let tiles = select topLeft bottomRight board
+        gMode = gameMode board
+     in if check gMode tiles
+            then
+                over (#players % (ix idx) % #score) (+ 1) state
+            else state

src/Types/Player.hs

@@ -1,5 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 module Types.Player where
 
+import Optics
+
 import Data.Text
 
 newtype PlayerName = MkPlayerName Text
@@ -10,3 +14,5 @@ data PlayerState = MkPlayerState
     , score :: Int
     }
     deriving (Eq, Show)
+
+makeFieldLabelsNoPrefix ''PlayerState