diff --git a/numbersquare.cabal b/numbersquare.cabal index 360ba98..799db3b 100644 --- a/numbersquare.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index 967ca5f..05e7b0d 100644 --- a/package.yaml +++ b/package.yaml @@ -27,6 +27,9 @@ default-extensions: - MultiParamTypeClasses - TypeFamilies - UndecidableInstances + - OverloadedLabels + - NamedFieldPuns + - TypeOperators library: source-dirs: diff --git a/src/Types/BoardAction.hs b/src/Types/BoardAction.hs new file mode 100644 index 0000000..40616ef --- /dev/null +++ b/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) diff --git a/src/Types/GameMode.hs b/src/Types/GameMode.hs index 712292d..994837b 100644 --- a/src/Types/GameMode.hs +++ b/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. diff --git a/src/Types/GameState.hs b/src/Types/GameState.hs index 8ac007c..a342625 100644 --- a/src/Types/GameState.hs +++ b/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 diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 462568f..45b38e3 100644 --- a/src/Types/Player.hs +++ b/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