diff --git a/README.md b/README.md index 1837486..5bfbfec 100644 --- a/README.md +++ b/README.md @@ -5,10 +5,12 @@ Early Work In Progress! Overall, the architecture is MVC (Model, View, Controller) and some event-driven programming. See discussions on architecture [here](app/Model.md). +Caveat to those who built locally and are viewing the source in vscode: For reasons unknown (but is related to +usage of `OverloadedRecordUpdate` and `OverloadedRecordDot`), files dependant on `Model.hs` only typechecks +when `Model.hs` is open. + ### Roadmap 1. [x] Basic Game Loop. 2. [ ] Support all Tier 1 cards. The hardest to implement would be Scallywag. 3. [ ] Support all cards, completing the single player mode experience. -4. [ ] Server, game rooms, authentication. - - +4. [ ] Server, game rooms, authentication. \ No newline at end of file diff --git a/battlegrounds.cabal b/battlegrounds.cabal index 7d2c80e..2dbde9c 100644 --- a/battlegrounds.cabal +++ b/battlegrounds.cabal @@ -81,7 +81,9 @@ test-suite battlegrounds-test build-depends: base >=4.7 && <5 , battlegrounds - , containers ==0.6.7 + , large-generics ==0.2.2 + , large-records ==0.4.1 + , record-hasfield , tasty , tasty-hunit default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index babe042..f276d4f 100644 --- a/package.yaml +++ b/package.yaml @@ -72,6 +72,9 @@ tests: - -with-rtsopts=-N dependencies: - battlegrounds - - containers == 0.6.7 + # - containers == 0.6.7 - tasty - - tasty-hunit \ No newline at end of file + - tasty-hunit + - large-generics == 0.2.2 + - large-records == 0.4.1 + - record-hasfield \ No newline at end of file diff --git a/src/Card.hs b/src/Card.hs index a6e7a4b..12787f2 100644 --- a/src/Card.hs +++ b/src/Card.hs @@ -21,7 +21,7 @@ harmlessBonehead = baseCost = 3, attack = 1, health = 1, - deathrattle = [Summon skeleton, Summon skeleton] + deathrattle = [Summon (SpecificCard skeleton), Summon (SpecificCard skeleton)] } dummy :: Card diff --git a/src/Combat.hs b/src/Combat.hs index 9eed781..92d6421 100644 --- a/src/Combat.hs +++ b/src/Combat.hs @@ -79,14 +79,14 @@ turn di cs = (cs''', history) one.playerState.board = clearDeath cs''.one.playerState.board, two.playerState.board = clearDeath cs''.two.playerState.board } - history = map extractBoards [cs, cs''] ++ snapshots ++ [extractBoards cs'''] + history = map extractBoards [cs, cs'] ++ [extractBoards cs'' | not (null snapshots)] ++ [extractBoards cs'''] -- handleDeaths is recursive because certain deathrattles cause other minions to die. -- deathrattles are always handled in the order the minion died (and left-to-right on tie) handleDeaths :: CombatState -> (CombatState, CombatHistory) handleDeaths cs = if null (prepareDeathrattles cs) - then (cs', histories) + then (cs', []) else second (histories ++) (handleDeaths cs') -- keeping handling deaths if they come! where (cs', states) = mapAccumL (\cs' (fighter, id, eff) -> (interpCombatEffect (CombatEffectContext cs' fighter id) eff, cs')) cs (prepareDeathrattles cs) diff --git a/src/Controller.hs b/src/Controller.hs index 76b104a..116ff53 100644 --- a/src/Controller.hs +++ b/src/Controller.hs @@ -92,10 +92,10 @@ initGameState :: GameState initGameState = GameState {playerState = defPlayerState, aiState = tutorialAI, turn = 0, config = Config {maxBoardSize = 7, maxHandSize = 10}} tutorialAI :: PlayerState -tutorialAI = defPlayerState {board = [CardInstance bigDumbo], hp = 5} +tutorialAI = mainPlayerState {board = [CardInstance bigDumbo 0], hp = 5} -defPlayerState :: PlayerState -defPlayerState = +mainPlayerState :: PlayerState +mainPlayerState = PlayerState { tier = 1, maxGold = 300, -- By `enter`ing into the first turn, this becomes 3 as required. diff --git a/src/Model.hs b/src/Model.hs index 8d3f823..27b8569 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -76,7 +76,7 @@ data Card = Card type MinionID = Int -newtype IdGen = IdGen {unIdGen :: MinionID} deriving (Show) +newtype IdGen = IdGen {unIdGen :: MinionID} deriving (Eq, Show) {-# ANN type CardInstance largeRecord #-} data CardInstance = CardInstance @@ -105,7 +105,7 @@ data Phase = HeroSelect | Recruit | Combat | EndScreen deriving (Show, Eq) data Player = Player | AI deriving (Show, Eq) {-# ANN type Config largeRecord #-} -data Config = Config {maxBoardSize :: Int, maxHandSize :: Int, maxCombatBoardSize :: Int} deriving (Show) +data Config = Config {maxBoardSize :: Int, maxHandSize :: Int, maxCombatBoardSize :: Int} deriving (Eq, Show) {-# ANN type CombatSimulation largeRecord #-} data CombatSimulation = CombatSimulation @@ -128,10 +128,10 @@ data FighterState = FighterState { playerState :: PlayerState, -- so that we can perform effects (add cards to hand), deal damage to players, etc nextAttackIndex :: NextAttackIndex } - deriving (Show) + deriving (Eq, Show) {-# ANN type CombatState largeRecord #-} -data CombatState = CombatState {attacker :: Fighter, one :: FighterState, two :: FighterState, config :: Config} deriving (Show) +data CombatState = CombatState {attacker :: Fighter, one :: FighterState, two :: FighterState, config :: Config} deriving (Eq, Show) data Fighter = One | Two deriving (Show, Eq) @@ -161,7 +161,25 @@ data PlayerState = PlayerState phase :: Phase, idGen :: IdGen } - deriving (Show) + deriving (Eq, Show) + +defPlayerState :: PlayerState +defPlayerState = PlayerState { + tier = 0, + maxGold = 0, + curGold = 0, + tierUpCost = 0, + shop = [], + frozen = False, + board = [], + hand = [], + hp = 10, + armor = 0, + alive = True, + rerollCost = 1, + phase = Recruit, + idGen = IdGen 0 +} {-# ANN type GameState largeRecord #-} data GameState = GameState @@ -170,7 +188,7 @@ data GameState = GameState config :: Config, turn :: Turn } - deriving (Show) + deriving (Eq, Show) type Index = Int diff --git a/test/CombatTest.hs b/test/CombatTest.hs index 765d672..a469141 100644 --- a/test/CombatTest.hs +++ b/test/CombatTest.hs @@ -1,49 +1,81 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedRecordUpdate #-} +{-# LANGUAGE RebindableSyntax #-} +{-# OPTIONS_GHC -fplugin=Data.Record.Plugin #-} module CombatTest (module CombatTest) where import Card -import Data.Maybe (fromJust) -import Model +import Combat +import Control.Arrow (second) +import Data.Record.Overloading hiding (loop) +import Model hiding (turn) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (assertEqual, testCase) +import Test.Tasty.HUnit (Assertion, assertEqual, testCase) combatTestGroup :: TestTree combatTestGroup = testGroup - "Combat Tests" - [ testHarmlessBonehead + "test basic combats via histories" + [ assert1v1HarmlessBonehead ] -testHarmlessBonehead :: TestTree -testHarmlessBonehead = - testCase "Expected combat state after player Harmless Bonehead attacks enemy Harmless Bonehead and dies." $ do - assertEqual - "Attack indices update correctly after bonehead death + summon, boneheads are the only minions." - after - (snipe 0 before) - assertEqual - "Attack indices update correctly after bonehead death + summon, when other minions exist before bonehead." - after' - (snipe 1 before') +type HardCodedTurn = (CombatState -> (CombatState, CombatHistory)) -- See signature of `turn`. + +-- Frequently, we wish to test the expected history after a series of turns. +-- There is a tradeoff with testing history versus testing combat states: +-- Pro: Easier to write +-- Con: Slightly less rigorous. Harder to localize error (at which turn did state go wrong?) +makeMultiturnHistoryAssertionTest :: CombatHistory -> CombatState -> [HardCodedTurn] -> Assertion +makeMultiturnHistoryAssertionTest expectedHistory cs turns = + assertEqual + "Expected same history" + expectedHistory + ( snd -- discard CombatState since we just want history + $ foldl + (\(cs, histAcc) t -> second (histAcc ++) (t cs)) -- + (cs, []) -- initial state and the history accumulator. + turns + ) + +assert1v1HarmlessBonehead :: TestTree +assert1v1HarmlessBonehead = + testCase "Two boneheads full battle" $ makeMultiturnHistoryAssertionTest expectedHistory initialCS turns where - before = - CombatState - { attacker = FighterState {nextAttackIndex = 0, fighter = One, board = [CardInstance harmlessBonehead]}, - defender = FighterState {nextAttackIndex = 0, fighter = Two, board = [CardInstance harmlessBonehead]} + turns = [turn 0, turn 1, turn 0] + onePS = + defPlayerState + { phase = Combat, + board = [CardInstance harmlessBonehead 0], + idGen = IdGen 1 } - after = - CombatState - { attacker = FighterState {nextAttackIndex = 0, fighter = One, board = [CardInstance skeleton, CardInstance skeleton]}, - defender = FighterState {nextAttackIndex = 0, fighter = Two, board = [CardInstance skeleton, CardInstance skeleton]} + twoPS = + defPlayerState + { phase = Combat, + board = [CardInstance harmlessBonehead 0], + idGen = IdGen 1 } - before' = + initialCS = CombatState - { attacker = FighterState {nextAttackIndex = 1, fighter = One, board = [CardInstance dummy, CardInstance harmlessBonehead]}, - defender = FighterState {nextAttackIndex = 1, fighter = Two, board = [CardInstance dummy, CardInstance harmlessBonehead]} + { attacker = One, + one = FighterState {nextAttackIndex = 0, playerState = onePS}, + two = FighterState {nextAttackIndex = 0, playerState = twoPS}, + config = Config {maxBoardSize = 7, maxHandSize = 10, maxCombatBoardSize = 7} } - after' = - CombatState - { attacker = FighterState {nextAttackIndex = 1, fighter = One, board = [CardInstance dummy, CardInstance skeleton, CardInstance skeleton]}, - defender = FighterState {nextAttackIndex = 1, fighter = Two, board = [CardInstance dummy, CardInstance skeleton, CardInstance skeleton]} - } \ No newline at end of file + expectedHistory = + [ ([CardInstance harmlessBonehead 0], [CardInstance harmlessBonehead 0]), + ([CardInstance harmlessBonehead {health = 0} 0], [CardInstance harmlessBonehead {health = 0} 0]), + ([CardInstance skeleton 1], [CardInstance skeleton 1]), + ([CardInstance skeleton 1, CardInstance skeleton 2], [CardInstance skeleton 1, CardInstance skeleton 2]), + ([CardInstance skeleton 1, CardInstance skeleton {health = 0} 2], [CardInstance skeleton {health = 0} 1, CardInstance skeleton 2]), + ([CardInstance skeleton 1], [CardInstance skeleton 2]), + ([CardInstance skeleton {health = 0} 1], [CardInstance skeleton {health = 0} 2]), + ([], []) + ] \ No newline at end of file diff --git a/test/Spec.hs b/test/Spec.hs index 558042a..1890582 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,4 +1,5 @@ import Test.Tasty (defaultMain, testGroup) +import CombatTest main :: IO () -main = defaultMain $ testGroup "Unit Tests" [] \ No newline at end of file +main = defaultMain $ testGroup "Unit Tests" [combatTestGroup] \ No newline at end of file