Better overall logic

- got rid of `enter` and `render` because their implementations for different phases were very different. For example, `render Recruit` is essentially a string while `render Combat` replays a whole combat, slice by slice with threaded interval timers.
- `fight` no longer adds combat to player state, it directly returns the simulation for the game loop to render

battlegrounds.cabal

@@ -73,7 +73,6 @@ test-suite battlegrounds-test
   main-is: Spec.hs
   other-modules:
       CombatTest
-      ViewTest
       Paths_battlegrounds
   autogen-modules:
       Paths_battlegrounds

src/Combat.hs

@@ -20,22 +20,22 @@ dealDmg n (hp, armor) = (hp - hpDmg, armor - armorDmg)
     armorDmg = min n armor
     hpDmg = n - armorDmg
 
--- `fight` simulates the combat and logs every move and intermediate combat state.
-fight :: (MonadRandom m) => Player -> Player -> GameState -> m GameState
+-- `fight` simulates the combat
+fight :: (MonadRandom m) => Player -> Player -> GameState -> m (GameState, CombatSimulation)
 fight p1 p2 gs = do
   (sequence, finalState) <- simulateCombat ((selectPlayer p1 gs).board, (selectPlayer p2 gs).board)
   let result = calculateResult finalState
-  let gs' = gs {playerState.phase = Combat, playerState.combatToReplay = CombatSimulation [] sequence result}
+  let sim = CombatSimulation [] sequence result
   case result of
-    Tie -> return gs'
+    Tie -> return (gs, sim)
     Loss contestant dmg ->
       let loser = case contestant of
             One -> Player
             Two -> AI
-          loserState = selectPlayer loser gs'
+          loserState = selectPlayer loser gs
           (hp', armor') = dealDmg dmg (loserState.hp, loserState.armor)
           loserState' = loserState {hp = hp', armor = armor', alive = hp' > 0}
-       in return $ updatePlayer loser loserState' gs'
+       in return (updatePlayer loser loserState' gs, sim)
 
 -- For now, the algorithm is wrong but simple:
 -- Players do alternate attacking, but the attacking and defending minions are both random.

src/Controller.hs

@@ -1,33 +1,33 @@
 -- Controller: Handles input, game loop
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE DataKinds              #-}
-{-# LANGUAGE DuplicateRecordFields  #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE GADTs                  #-}
-{-# LANGUAGE KindSignatures         #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE OverloadedRecordDot    #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedRecordUpdate #-}
-{-# LANGUAGE RebindableSyntax       #-}
+{-# LANGUAGE RebindableSyntax #-}
 {-# OPTIONS_GHC -fplugin=Data.Record.Plugin #-}
+
 module Controller (module Controller) where
 
-import Prelude
-import Data.Record.Overloading
 import Card (bigDumbo)
-import Control.Monad.Random (MonadRandom (getRandom), MonadIO, liftIO)
-import Logic (enter, execCommand, isGameOver)
+import Combat (fight)
+import Control.Monad.Random (MonadIO, MonadRandom (getRandom), liftIO)
+import Data.Record.Overloading hiding (loop)
+import qualified Data.Text.Lazy as TL
+import Debug.Trace (trace, traceM)
+import GHC.Base (when)
+import Logic (execCommand, isGameOver, replenish)
 import Model
+import System.IO (hFlush, hReady, stdin, stdout)
 import Text.Parsec hiding (Error)
 import Text.Parsec.String (Parser)
-import Text.Read (readMaybe)
-import View (render)
-import System.IO (hReady, stdin, hFlush, stdout)
-import GHC.Base (when)
 import Text.Pretty.Simple (pPrint, pShow)
-import Debug.Trace (trace, traceM)
-import qualified Data.Text.Lazy as TL
-import Combat (fight)
+import Text.Read (readMaybe)
+import View
 
 -- START: Functions for ingesting terminal input as PlayerAction --
 -- Examples:
@@ -91,7 +91,7 @@ playArgParser = do
 initGameState :: (MonadRandom m) => m GameState
 initGameState = do
   tutorialAIGameState <- tutorialAI
-  return $ GameState {playerState = defPlayerState, aiState = tutorialAIGameState, turn = 0, config = Config { maxBoardSize = 7, maxHandSize = 10 }}
+  return $ GameState {playerState = defPlayerState, aiState = tutorialAIGameState, turn = 0, config = Config {maxBoardSize = 7, maxHandSize = 10}}
 
 tutorialAI :: (MonadRandom m) => m PlayerState
 tutorialAI = do
@@ -113,52 +113,57 @@ defPlayerState =
       hp = 20,
       armor = 0,
       alive = True,
-      phase = HeroSelect,
-      combatToReplay = CombatSimulation [] [] Tie
+      phase = Recruit
     }
 
 runGame :: IO ()
 runGame = do
   gs <- initGameState
-  gs' <- enter Recruit Player gs
-  _ <- loop (return gs')
+  _ <- loop $ return gs
   putStrLn "Game Loop Completed."
   where
     -- Repeat Recruit and Combat until game over
     loop :: (MonadIO m, MonadRandom m) => m GameState -> m GameState
     loop mgs = do
       gs <- mgs
-      if isGameOver gs
-        then do
-          gs' <- enter EndScreen Player gs
-          _ <- liftIO $ render gs' Player -- Render the EndScreen before exit.
-          -- trace "Before loop finally returns" 
-          -- $ 
-          return gs'
-      else 
-        -- trace (TL.unpack $ pShow gs) 
-        -- $ 
-        case gs.playerState.phase of
+      -- Go to EndScreen if applicable
+      let gs' = gs {playerState.phase = if isGameOver gs then EndScreen else gs.playerState.phase}
+      -- trace (TL.unpack $ pShow gs)
+      case gs'.playerState.phase of
         Recruit -> do
-          liftIO $ render gs Player
-          liftIO $ putStr "> "
-          liftIO $ hFlush stdout
-          input <- liftIO getLine
-          result <- either -- Combine two eithers: If first action Left, propogate it. If right, execCommand and return an Either.
-                      (return . Left)
-                      (\cmd -> execCommand cmd gs Player)
-                      (interp input)
-          case result of -- Earlier, two eithers were combined together because they should run the same thing on Left.
-            Left err -> liftIO (putStrLn err) >> loop (return gs)
-            Right gs' -> loop (return gs')
+          replenishedPlayer <- replenish gs'.playerState
+          replenishedAI <- replenish gs'.aiState
+          let gs'' = gs' {playerState = replenishedPlayer, aiState = replenishedAI}
+          recruitLoop gs'' >>= (loop . return)
         Combat -> do
-          gs' <- fight Player AI gs
-          liftIO $ render gs' Player
-          liftIO flushInput
-          loop $ enter Recruit Player gs'
-        _ -> mgs
+          (gs'', sim) <- fight Player AI gs'
+          liftIO $ replayCombat 1 sim
+          liftIO flushInput -- ignore input entered during combat phase
+          liftIO $ putStrLn "finished playing"
+          loop $ return gs'' {playerState.phase = Recruit, aiState.phase = Recruit}
+        EndScreen -> do
+          -- Note EndScreen doesn't invoke `loop`. Game logic stops here.
+          liftIO $ putStrLn $ endScreenMsg gs'
+          return gs
+        _ -> error "Other phases not yet implemented"
+
+recruitLoop :: (MonadIO m, MonadRandom m) => GameState -> m GameState
+recruitLoop gs
+  | gs.playerState.phase == Recruit = do
+      liftIO $ putStrLn $ fmtRecruit gs Player
+      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
 
--- ignore input entered during combat phase
 flushInput :: IO ()
 flushInput = do
   ready <- hReady stdin

src/Logic.hs

@@ -1,25 +1,23 @@
 -- Logic: Handles recruit phase logic, executing user commands
 -- TODO: Modularize out the recruit logic, since Combat.hs is already separate.
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE DataKinds              #-}
-{-# LANGUAGE DuplicateRecordFields  #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE GADTs                  #-}
-{-# LANGUAGE KindSignatures         #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE OverloadedRecordDot    #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedRecordUpdate #-}
-{-# LANGUAGE RebindableSyntax       #-}
 {-# LANGUAGE ParallelListComp #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RebindableSyntax #-}
 
 module Logic (module Logic) where
 
-import Data.Record.Overloading
-
 import Card (pool)
 import Control.Monad.Random
-import Data.Functor ((<&>))
+import Data.Record.Overloading
 import Model
 import Utils
 import View (helpMenu)
@@ -28,8 +26,12 @@ execCommand :: (MonadIO m, MonadRandom m) => Command -> GameState -> Player -> m
 execCommand (Buy ind) gs p = return $ buy ind gs p >>= (\ps' -> Right $ updatePlayer p ps' gs)
 execCommand (Sell ind) gs p = return $ sell ind (selectPlayer p gs) >>= (\ps' -> Right $ updatePlayer p ps' gs)
 execCommand (Play ind) gs p = return $ play ind gs p >>= (\ps' -> Right $ updatePlayer p ps' gs)
-execCommand Help gs _ = liftIO (putStrLn helpMenu) >> pure (Right gs)
-execCommand EndTurn gs p = enter Combat p gs <&> Right
+execCommand Help gs Player = liftIO (putStrLn helpMenu) >> pure (Right gs)
+execCommand Help gs AI = error "Dev Error: AI shouldn't issue `Help`."
+execCommand EndTurn gs Player = return $ Right gs { playerState.phase = Combat }
+-- In tutorial mode, the single player issues the combat (on their will) and fights the AI always
+-- In multiplayer, the server issues the combat (by a timer) and pairs up who to fight
+execCommand EndTurn _ AI = error "Dev Error: AI really shouldn't issue `EndTurn`." 
 execCommand Roll gs p = do
   ps' <- roll $ selectPlayer p gs
   return $ liftM2 (updatePlayer p) ps' (return gs)
@@ -42,42 +44,19 @@ isGameOver :: GameState -> Bool
 isGameOver gs = gs.playerState.alive /= gs.aiState.alive
 
 -- Performed when we first transition to a new game phase.
-enter :: (MonadRandom m) => Phase -> Player -> GameState -> m GameState
-enter Recruit Player gs = do
-  -- Entering Player's recruit phase triggers AI to perform same logic
-  newPlayerState <- enter' gs.playerState
-  newAIState <- enter' gs.aiState
-  return
-    gs
-      { playerState = newPlayerState,
-        aiState = newAIState
-      }
-  where
-    enter' ps = do
-      newShop <- randomShop ps.tier
-      return $
-        ps
-          { phase = Recruit,
-            maxGold = ps.maxGold + 1,
-            curGold = ps.maxGold + 1,
-            frozen = False,
-            shop = if ps.frozen then ps.shop else newShop
-          }
--- fight! And then
--- 1) provide the render phase with simulation sequence
--- 2) unleash the damage
-enter Combat p gs = do
-  let newState = (selectPlayer p gs) { phase = Combat }
-  return $ updatePlayer p newState gs
-enter EndScreen p gs = do
-  let newState = (selectPlayer p gs) { phase = EndScreen }
-  return $ updatePlayer p newState gs
-enter _ _ _ = error "Other phases are not yet enterable"
-
+replenish :: (MonadRandom m) => PlayerState -> m PlayerState
+replenish ps = do
+  newShop <- randomShop ps.tier
+  return ps
+    { phase = Recruit,
+      maxGold = ps.maxGold + 1,
+      curGold = ps.maxGold + 1,
+      frozen = False,
+      shop = if ps.frozen then ps.shop else newShop
+    }
 
 -- START: Utility Methods for PlayerAction Functions --
 -- Determinisitc functions should only be used when the usage permits only the happy path
-
 deterministicLookup :: (Eq a) => a -> [(a, b)] -> b
 deterministicLookup a xs =
   case lookup a xs of
@@ -183,6 +162,6 @@ freeze ps = return ps {frozen = not ps.frozen}
 
 -- Kill player and move their render screen to the EndScreen
 concede :: PlayerState -> Either String PlayerState
-concede ps = return ps {alive = False, phase = EndScreen}
+concede ps = return ps {alive = False}
 
 -- END --

src/Model.hs

@@ -123,8 +123,7 @@ data PlayerState = PlayerState
     armor :: Armor,
     alive :: Bool,
     rerollCost :: Gold,
-    phase :: Phase,
-    combatToReplay :: CombatSimulation
+    phase :: Phase
   } deriving Show
 
 {-# ANN type GameState largeRecord #-}