More State pattern refactor; PlayerMap; More Eff integration #2

battlegrounds.cabal

@@ -31,7 +31,6 @@ library
       Effect
       Logic
       Model
-      Utils
       View
   other-modules:
       Paths_battlegrounds

src/Card.hs

@@ -3,6 +3,11 @@
 module Card (module Card) where
 
 import Model
+  ( Card (..),
+    CardCriteria (..),
+    CardEffect (..),
+    CardName (..),
+  )
 
 pool :: [Card]
 pool = [dummy, dumber, triDummy, dumbo, bigDumbo, kingDumbo]

src/Combat.hs

@@ -1,18 +1,19 @@
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Combat where
 
 import Control.Lens hiding (Index)
 import Data.Bifunctor (Bifunctor (second))
 import Data.List (findIndex, mapAccumL)
+import Data.Map ((!))
 import Data.Maybe (fromJust)
 import Debug.Trace (trace)
+import Effect (RNG, getRandomR)
+import Effectful (Eff, (:>))
 import Logic (genId)
 import Model hiding (turn)
-import Utils (selectPlayer, updatePlayer)
-import Effectful (Eff, (:>))
-import Effect (RNG, getRandomR)
+import Effectful.State.Static.Local
 
 dealDmg :: Int -> (Health, Armor) -> (Health, Armor)
 dealDmg n (hp, armor) = (hp - hpDmg, armor - armorDmg)
@@ -21,31 +22,39 @@ dealDmg n (hp, armor) = (hp - hpDmg, armor - armorDmg)
     hpDmg = n - armorDmg
 
 -- `fight` simulates the combat
-fight :: (RNG :> es) => Player -> Player -> GameState -> Eff es (GameState, CombatSimulation)
-fight p1 p2 gs = do
-  sequence <- simulateCombat p1 p2 gs
+fight :: (State GameState :> es, RNG :> es) => (PlayerId, PlayerId) -> Eff es CombatSimulation
+fight (p1Id, p2Id) = do
+  gs <- get
+  let p1State = (gs ^. playerMap) ! p1Id
+  let p2State = (gs ^. playerMap) ! p2Id
+  sequence <- simulateCombat (p1Id, p2Id)
   let result = calculateResult (last sequence)
   let sim = CombatSimulation [] sequence result
   case result of
-    Tie -> return (gs, sim)
+    Tie -> return sim
     Loss fighter dmg -> do
-      let loser = case fighter of
-            One -> Player
-            Two -> AI
-          loserState = selectPlayer loser gs
+      let (loserId, loserState) = case fighter of
+            One -> (p1Id, p1State)
+            Two -> (p2Id, p2State)
           (hp', armor') = dealDmg dmg (loserState ^. hp, loserState ^. armor)
-          loserState' = loserState & hp .~ hp'
-                                 & armor .~ armor'
-                                 & alive .~ (hp' > 0)
-      return (updatePlayer loser loserState' gs, sim)
-
-simulateCombat :: (RNG :> es) => Player -> Player -> GameState -> Eff es CombatHistory
-simulateCombat p1 p2 gs = do
-  let (p1State, p2State) = (selectPlayer p1 gs, selectPlayer p2 gs)
+          loserState' =
+            loserState
+              & hp .~ hp'
+              & armor .~ armor'
+              & alive .~ (hp' > 0)
+      put $ gs & playerMap . ix loserId .~ loserState'
+      return sim
+
+simulateCombat :: (State GameState :> es, RNG :> es) => (PlayerId, PlayerId) -> Eff es CombatHistory
+simulateCombat (p1Id, p2Id) = do
+  gs <- get
+  let p1State = (gs ^. playerMap) ! p1Id
+  let p2State = (gs ^. playerMap) ! p2Id
   initialAttacker <- initAttacker (p1State ^. board) (p2State ^. board)
+
   go
     (CombatState initialAttacker (FighterState p1State 0) (FighterState p2State 0) (gs ^. config))
-    [] -- initial board is part of state
+    [(p1State ^. board, p2State ^. board)] -- initial board is part of state
   where
     go :: (RNG :> es) => CombatState -> CombatHistory -> Eff es CombatHistory
     go combatState history = do
@@ -60,9 +69,8 @@ simulateCombat p1 p2 gs = do
           go combatState' (history ++ newHistorySlices)
 
     combatEnded :: CombatState -> Bool
-    combatEnded combatState = 
-      null (combatState ^. one . fplayerState . board) || 
-      null (combatState ^. two . fplayerState . board)
+    combatEnded cs =
+      null (cs ^. one . fplayerState . board) || null (cs ^. two . fplayerState . board)
 
 turn ::
   DefenderIndex -> -- Since the caller of `turn` specifies the `di`, testing single turns is easy.
@@ -75,14 +83,13 @@ turn di cs = (cs''', history)
       Two -> (cs ^. two, cs ^. one)
     cs' = trade (attackingState ^. nextAttackIndex) di cs
     (cs'', snapshots) = handleDeaths cs' -- `handleDeath` does not clean the battleground (clear deaths)
-    cs''' = cs''
-      & attacker .~ alternate (cs'' ^. attacker)
-      & one . fplayerState . board .~ clearDeath (cs'' ^. one . fplayerState . board)
-      & two . fplayerState . board .~ clearDeath (cs'' ^. two . fplayerState . board)
+    cs''' =
+      cs''
+        & attacker .~ alternate (cs'' ^. attacker)
+        & one . fplayerState . board .~ clearDeath (cs'' ^. one . fplayerState . board)
+        & two . fplayerState . board .~ clearDeath (cs'' ^. two . fplayerState . board)
     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)
@@ -92,7 +99,7 @@ handleDeaths cs =
     (cs', states) = mapAccumL (\cs' (fighter, id, eff) -> (interpCombatEffect (CombatEffectContext cs' fighter id) eff, cs')) cs (prepareDeathrattles cs)
     histories = map extractBoards (tail states) -- be rid of the head, which is the original `cs`
     prepareDeathrattles :: CombatState -> [(Fighter, MinionID, CardEffect)]
-    prepareDeathrattles = undefined
+    prepareDeathrattles cs = [] -- TODO: implement
 
 extractBoards :: CombatState -> (Board, Board)
 extractBoards cs = (cs ^. one . fplayerState . board, cs ^. two . fplayerState . board)
@@ -132,17 +139,21 @@ trade :: AttackerIndex -> DefenderIndex -> CombatState -> CombatState
 trade ai di cs = cs'
   where
     (attackingBoard, defendingBoard) = case cs ^. attacker of
-      One -> (cs ^. one.fplayerState.board, cs ^. two.fplayerState.board)
-      Two -> (cs ^. two.fplayerState.board, cs ^. one.fplayerState.board)
-      
+      One -> (cs ^. one . fplayerState . board, cs ^. two . fplayerState . board)
+      Two -> (cs ^. two . fplayerState . board, cs ^. one . fplayerState . board)
+
     (attackingMinion, defendingMinion) = (attackingBoard !! ai, defendingBoard !! di)
     (attackingMinion', defendingMinion') = dmgOther (attackingMinion, defendingMinion)
-    
+
     cs' = case cs ^. attacker of
-      One -> cs & one.fplayerState.board .~ attackingBoard
-                & two.fplayerState.board .~ defendingBoard
-      Two -> cs & one.fplayerState.board .~ defendingBoard
-                & two.fplayerState.board .~ attackingBoard
+      One ->
+        cs
+          & one . fplayerState . board .~ attackingBoard
+          & two . fplayerState . board .~ defendingBoard
+      Two ->
+        cs
+          & one . fplayerState . board .~ defendingBoard
+          & two . fplayerState . board .~ attackingBoard
 
     dmgOther :: (CardInstance, CardInstance) -> (CardInstance, CardInstance)
     dmgOther (attacker, defender) =

src/Controller.hs

@@ -1,29 +1,30 @@
+{-# LANGUAGE FlexibleContexts #-}
 -- Controller: Handles input, game loop
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleContexts #-}
 
 module Controller (module Controller) where
 
 import Card (bigDumbo)
 import Combat (fight)
+import Control.Lens
+import Data.Map (fromList, (!))
 import qualified Data.Text.Lazy as TL
 import Debug.Trace (trace, traceM)
+import Effect
+import Effectful
+import Effectful.Dispatch.Dynamic
+import Effectful.State.Static.Local
 import GHC.Base (when)
 import Logic (execCommand, isGameOver, replenish)
 import Model
 import System.IO (hFlush, hReady, stdin, stdout)
-import Text.Parsec hiding (Error)
+import System.Random (newStdGen)
+import Text.Parsec hiding (Error, State)
 import Text.Parsec.String (Parser)
 import Text.Pretty.Simple (pPrint, pShow)
 import Text.Read (readMaybe)
 import View
-import Control.Lens
-import Effectful
-import Effectful.Error.Static
-import Effectful.State.Static.Local
-import Effectful.Dispatch.Dynamic
-import Effect
-import System.Random (newStdGen)
+
 -- START: Functions for ingesting terminal input as PlayerAction --
 -- Examples:
 -- b 1    -> Buy 1
@@ -84,86 +85,106 @@ playArgParser = do
 -- END --
 
 initGameState :: GameState
-initGameState = GameState {_playerState = defPlayerState, _aiState = tutorialAI, _turn = 0, _config = Config {_maxBoardSize = 7, _maxHandSize = 10}}
+initGameState =
+  GameState
+    { _playerMap = fromList [(0, mainPlayerState), (1, tutorialAI)],
+      _turn = 0,
+      _config = Config {_maxBoardSize = 7, _maxHandSize = 10, _maxCombatBoardSize = 7}
+    }
 
 tutorialAI :: PlayerState
-tutorialAI = mainPlayerState 
-  & board .~ [CardInstance bigDumbo 0]
-  & hp .~ 5
+tutorialAI =
+  mainPlayerState
+    & board .~ [CardInstance bigDumbo 0]
+    & hp .~ 5
 
 mainPlayerState :: PlayerState
 mainPlayerState =
-  PlayerState
+  defPlayerState
     { _tier = 1,
       _maxGold = 300, -- By `enter`ing into the first turn, this becomes 3 as required.
       _curGold = 2,
       _tierUpCost = 6, -- By `enter`ing into the first turn, this becomes 5 as required.
       _rerollCost = 1,
-      _shop = [],
-      _board = [],
-      _hand = [],
-      _frozen = False,
       _hp = 20,
       _armor = 0,
       _alive = True,
-      _phase = Recruit,
-      _idGen = IdGen 0
+      _phase = Recruit
     }
 
+mainPlayerId :: Int
+mainPlayerId = 0
+
+aiPlayerId :: Int
+aiPlayerId = 1
+
 runGame :: IO ()
 runGame = do
   gen <- newStdGen
-  _ <- runEff . runRNG gen $ loop $ return initGameState
+  _ <- runEff . runRNG gen . evalState initGameState $ loop
   putStrLn "Game Loop Completed."
   where
     -- Repeat Recruit and Combat until game over
-    loop :: (IOE :> es, RNG :> es) => Eff es GameState -> Eff es GameState
-    loop mgs = do
-      gs <- mgs
-      let gs' = gs & playerState.phase %~ \p -> if isGameOver gs then EndScreen else p
-
-      case gs' ^. playerState.phase of
+    loop :: (IOE :> es, RNG :> es, State GameState :> es) => Eff es ()
+    loop = do
+      gs <- get
+      let mainPlayerPhase = (gs ^. playerMap) ! mainPlayerId ^. phase
+          gs' =
+            if isGameOver gs
+              then gs & playerMap . ix mainPlayerId . phase .~ EndScreen
+              else gs
+
+      case mainPlayerPhase of
         Recruit -> do
-          replenishedPlayer <- replenish (gs' ^. playerState)
-          replenishedAI <- replenish (gs' ^. aiState)
-          let gs'' = gs' & playerState .~ replenishedPlayer 
-                        & aiState .~ replenishedAI
-          recruitLoop gs'' >>= (loop . return)
-
+          case (gs' ^. playerMap . at mainPlayerId, gs' ^. playerMap . at aiPlayerId) of
+            (Just mainPlayer, Just aiPlayer) -> do
+              replenishedPlayer <- replenish mainPlayer
+              replenishedAI <- replenish aiPlayer
+              let gs'' =
+                    gs'
+                      & playerMap . ix mainPlayerId .~ replenishedPlayer
+                      & playerMap . ix aiPlayerId .~ replenishedAI
+              put gs''
+              recruitLoop
+              loop
+            _ -> error "Invalid player IDs in game state"
         Combat -> do
-          (gs'', sim) <- fight Player AI gs'
+          sim <- fight (mainPlayerId, aiPlayerId)
           liftIO $ replayCombat 1 sim
           liftIO flushInput
           liftIO $ putStrLn "finished playing"
-          loop $ return $ gs'' & playerState.phase .~ Recruit 
-                              & aiState.phase .~ Recruit
-
+          gs'' <- get
+          put $
+            gs''
+              & playerMap . ix mainPlayerId . phase .~ Recruit
+              & playerMap . ix aiPlayerId . phase .~ Recruit
+          loop
         EndScreen -> do
-          liftIO $ putStrLn $ endScreenMsg gs'
-          return gs
-
+          liftIO $ putStrLn $ endScreenMsg gs' mainPlayerId
         _ -> error "Other phases not yet implemented"
-
-recruitLoop :: (IOE :> es, RNG :> es) => GameState -> Eff es GameState
-recruitLoop gs
-  | (gs ^. playerState . phase) == Recruit = do
-      liftIO $ putStrLn $ fmtRecruit gs Player
+
+recruitLoop :: (IOE :> es, RNG :> es, State GameState :> es) => Eff es ()
+recruitLoop = do
+  gs <- get
+  case (gs ^. playerMap) ! 0 ^. phase of
+    Recruit -> do
+      liftIO $ putStrLn $ fmtRecruit gs 0
       liftIO $ putStr "> "
       liftIO $ hFlush stdout
       input <- liftIO getLine
-      result <-
-        either
-          (return . Left)
-          (\cmd -> execCommand cmd gs Player)
-          (interp input)
-      case result of
-        Left err -> liftIO (putStrLn err) >> recruitLoop gs
-        Right gs' -> recruitLoop gs'
-  | otherwise = return gs
+      either
+        (\_ -> return ())
+        ( \cmd -> do
+            res <- execCommand cmd 0
+            maybe (return ()) (\s -> liftIO (putStrLn s) >> recruitLoop) res
+        )
+        (interp input)
+      recruitLoop
+    _ -> return ()
 
 flushInput :: IO ()
 flushInput = do
   ready <- hReady stdin
   when ready $ do
-    _ <- getChar -- Ignores commands entered (pressing actual enter key), but, this does not ignore partially typed, not-yet-entered text
+    _ <- getChar
     flushInput