First good test written! It should fail because I'm TDDing

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.

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

package.yaml

@@ -72,6 +72,9 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - battlegrounds
-    - containers == 0.6.7
+    # - containers == 0.6.7
     - tasty
-    - tasty-hunit
+    - tasty-hunit
+    - large-generics == 0.2.2
+    - large-records == 0.4.1
+    - record-hasfield

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

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)

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.

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
 

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]}
-        }
+    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]),
+        ([], [])
+      ]

test/Spec.hs

@@ -1,4 +1,5 @@
 import Test.Tasty (defaultMain, testGroup)
+import CombatTest
 
 main :: IO ()
-main = defaultMain $ testGroup "Unit Tests" []
+main = defaultMain $ testGroup "Unit Tests" [combatTestGroup]