Wiser function scope; introduced Command

battlegrounds.cabal

@@ -29,6 +29,7 @@ library
       Controller
       Logic
       Model
+      Utils
       View
   other-modules:
       Paths_battlegrounds

src/Controller.hs

@@ -1,34 +1,32 @@
+-- Controller: Handles input, game loop
+
 module Controller (module Controller) where
 
 import Card (bigDumbo)
-import Control.Lens
 import Control.Monad.Random (MonadRandom (getRandom))
-import Data.Map hiding (foldl, map)
-import Data.Maybe (fromJust)
-import Logic (execAction, isGameOver, validateAction)
-import Model (Action (..), CardInstance (CardInstance), GameState (..), Phase (HeroSelect), PlayerState (..), playerStates)
+import Logic (execCommand, isGameOver, validateCommand, enter)
+import Model
 import Text.Parsec hiding (Error)
 import Text.Parsec.String (Parser)
 import Text.Read (readMaybe)
 import View (render)
 import Control.Monad.IO.Class (liftIO)
-import qualified Data.Map as Map
 
--- START: Functions for ingesting terminal input as Action --
+-- START: Functions for ingesting terminal input as PlayerAction --
 -- Examples:
 -- b 1    -> Buy 1
 -- buy 1  -> Buy 1
 -- s 0    -> Sell 0
 -- sell 1 -> Sell 1
 -- h      -> Help
 -- help   -> Help
-interp :: String -> Either String Action
+interp :: String -> Either String Command
 interp s = case parse actionParser "" s of
   Left _ -> Left "Unrecognized or incorrectly formatted command. Enter h for command list."
   Right a -> Right a
 
 -- Parse the full input string
-actionParser :: Parser Action
+actionParser :: Parser Command
 actionParser = do
   cmd <- choice $ map (try . string) ["buy", "b", "sell", "s", "help", "h", "endturn", "e", "play", "p"]
   spaces
@@ -37,7 +35,7 @@ actionParser = do
   return action
 
 -- Dispatch argument parser depending on command
-actionArgumentParser :: String -> Parser Action
+actionArgumentParser :: String -> Parser Command
 actionArgumentParser cmd
   | cmd `elem` ["buy", "b"] = buyArgParser
   | cmd `elem` ["sell", "s"] = sellArgParser
@@ -46,21 +44,21 @@ actionArgumentParser cmd
   | cmd `elem` ["endturn", "e"] = return EndTurn
   | otherwise = error "Unexpected path: actionArgumentParser should only run if it matched a command."
 
-buyArgParser :: Parser Action
+buyArgParser :: Parser Command
 buyArgParser = do
   indStr <- many1 digit
   case readMaybe indStr of
     Just ind -> return $ Buy ind
     Nothing -> fail "Buy's argument should be a valid number."
 
-sellArgParser :: Parser Action
+sellArgParser :: Parser Command
 sellArgParser = do
   indStr <- many1 digit
   case readMaybe indStr of
     Just ind -> return $ Sell ind
     Nothing -> fail "Sell's argument should be a valid number."
 
-playArgParser :: Parser Action
+playArgParser :: Parser Command
 playArgParser = do
   indStr <- many1 digit
   case readMaybe indStr of
@@ -71,7 +69,7 @@ playArgParser = do
 initGameState :: (MonadRandom m) => m GameState
 initGameState = do
   tutorialAIGameState <- tutorialAI
-  return $ GameState {_playerStates = fromList [("player", defPlayerState), ("tutorialAI", tutorialAIGameState)], turn = 0}
+  return $ GameState {playerState = defPlayerState, aiState=tutorialAIGameState, turn = 0}
 
 tutorialAI :: (MonadRandom m) => m PlayerState
 tutorialAI = do
@@ -89,19 +87,17 @@ defPlayerState =
       shop = [],
       board = [],
       hand = [],
-      phase = HeroSelect,
       frozen = False,
       hp = 20,
       armor = 0,
       alive = True,
-      opponentInformation = empty
+      phase = HeroSelect
     }
 
 runGame :: IO ()
 runGame = do
   gs <- initGameState
-  initialMainPlayerState <- execAction StartGame ((gs ^. playerStates) Map.! "player")
-  let gs' = gs & playerStates . ix "player" .~ initialMainPlayerState
+  gs' <- enter Recruit gs
   _ <- loop gs'
   putStrLn "Game Finished."
   where
@@ -111,12 +107,11 @@ runGame = do
         then do
           return gs
         else do
-          let mainPlayerState = fromJust $ Data.Map.lookup "player" (_playerStates gs)
-          putStrLn $ render mainPlayerState
+          putStrLn $ render gs Player
           input <- getLine
-          case interp input >>= (`validateAction` mainPlayerState) of
+          case interp input >>= (\c -> validateCommand c gs Player) of
             Left err -> putStrLn err >> loop gs
             Right action' -> do
-              newPlayerState <- liftIO $ execAction action' mainPlayerState
-              loop (gs & playerStates . at "player" ?~ newPlayerState)
+              gs' <- liftIO $ execCommand action' gs Player
+              loop gs' 
 

src/Logic.hs

@@ -1,80 +1,89 @@
--- -- Logic of the game
+-- -- Logic: Handles game logic, executing user commands
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE ParallelListComp #-}
 
 module Logic (module Logic) where
 
 import Card (pool)
-import Control.Lens ((^.))
 import Control.Monad.Random
 import Model
-import View (helpMenu)
+import View ( helpMenu )
+import Utils
 
--- START: Functions interfacing with Action. --
+-- START: Functions interfacing with PlayerAction. --
 
 -- Can action occur in given PlayerState? Yes then thread the same action through. False then error message.
-validateAction :: Action -> PlayerState -> Either String Action
-validateAction (Buy ind) gs
+validateCommand :: Command -> GameState -> Player -> Either String Command
+validateCommand (Buy ind) gs p
   | shopSize == 0 = Left "Your shop is empty."
   | ind < shopSize = return (Buy ind)
   | shopSize == 1 = Left "This hand only permits shop 0"
   | otherwise = Left $ "This shop only permits buy 0 to buy " ++ show (shopSize - 1)
   where
-    shopSize = length (shop gs)
-validateAction (Sell ind) gs
+    ps = selectPlayer p gs
+    shopSize = length ps.shop
+validateCommand (Sell ind) gs p
   | boardSize == 0 = Left "You have no board."
   | ind < boardSize = return (Sell ind)
   | boardSize == 1 = Left "This hand only permits sell 0"
   | otherwise = Left $ "This board only permits sell 0 to sell " ++ show (boardSize - 1)
   where
-    boardSize = length (board gs)
-validateAction (Play ind) gs
+    ps = selectPlayer p gs
+    boardSize = length ps.board
+validateCommand (Play ind) gs p
   | handSize == 0 = Left "You have an empty hand."
   | ind < handSize = return (Play ind)
   | handSize == 1 = Left "This hand only permits play 0"
   | otherwise = Left $ "This hand only permits play 0 to play " ++ show (handSize - 1)
   where
-    handSize = length (hand gs)
-validateAction StartGame ps = if phase ps == HeroSelect then return StartGame else Left "No need to start game if you're not in HeroSelect"
-validateAction EndTurn ps = if phase ps == Recruit then return EndTurn else Left "Doesn't make sense to end turn if you're not in Recruit"
-validateAction x _ = return x
-
-execAction :: (MonadIO m, MonadRandom m) => Action -> PlayerState -> m PlayerState
-execAction (Buy ind) gs = return $ buy ind gs
-execAction (Sell ind) gs = return $ sell ind gs
-execAction (Play ind) gs = return $ play ind gs
-execAction StartGame gs = enter Recruit gs -- For now, StartGame skips hero select. It should go into HeroSelect in the future
-execAction EndTurn gs = enter Combat gs
-execAction Help gs = liftIO (putStrLn helpMenu) >> return gs
+    ps = selectPlayer p gs
+    handSize = length ps.hand
 
+validateCommand EndTurn _ _ = return EndTurn
+validateCommand Help _ _ = return Help
+
+
+
+execCommand :: (MonadIO m, MonadRandom m) => Command -> GameState -> Player -> m GameState
+execCommand (Buy ind) gs p = return $ updatePlayer p (buy ind (selectPlayer p gs)) gs
+
+execCommand (Sell ind) gs p = return $ updatePlayer p (sell ind (selectPlayer p gs)) gs
+execCommand (Play ind) gs p = return $ updatePlayer p (play ind (selectPlayer p gs)) gs
+execCommand Help gs _ = liftIO (putStrLn helpMenu) >> return gs
+execCommand EndTurn gs _ = enter Combat gs
 -- END --
 
 -- START: Game Transition Functions --
 --   Check if only one player alive
 isGameOver :: GameState -> Bool
-isGameOver gs = playersAlive == (1 :: Integer)
-  where
-    playersAlive = foldl (\acc ps -> if alive ps then acc + 1 else acc) 0 (_playerStates gs)
+isGameOver gs = gs.playerState.alive /= gs.aiState.alive
 
 --   Performed when we first transition to a new game phase.
-enter :: (MonadRandom m) => Phase -> PlayerState -> m PlayerState
-enter Recruit ps = do
-  newShop <- randomShop (tier ps)
-  return $
-    ps
-      { maxGold = newGold,
-        curGold = newGold,
-        phase = Recruit,
-        frozen = False,
-        shop = if frozen ps then shop ps else newShop
-      }
+enter :: (MonadRandom m) => Phase -> GameState -> m GameState
+enter Recruit gs = do
+  newPlayerState <- replenish gs.playerState
+  newAIState     <- replenish gs.aiState
+  return gs
+    { 
+      playerState = newPlayerState,
+      aiState = newAIState
+    }
   where
-    newGold = maxGold ps + 1
-enter Combat ps = return $ ps { phase = Combat }
+    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
+        }
 enter _ _ = error "Other phases should not be enterable"
 
 -- END --
 
--- START: Utility Methods for Action Functions --
+-- 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
@@ -92,7 +101,7 @@ remove 0 (_ : xs) = xs
 remove n (x : xs) = x : remove (n - 1) xs
 
 canTierUp :: PlayerState -> Bool
-canTierUp ps = curGold ps >= tierUpCost ps
+canTierUp ps = ps.curGold >= ps.tierUpCost
 
 randomShop :: (MonadRandom m) => TavernTier -> m [CardInstance]
 randomShop t = do
@@ -101,7 +110,7 @@ randomShop t = do
   return [CardInstance uuid c | c <- shopCards | uuid <- ids]
   where
     availableCards :: [Card]
-    availableCards = filter (\card -> card ^. cardTier <= t) pool
+    availableCards = filter (\card -> card._cardTier <= t) pool
 
 sampleNFromList :: (MonadRandom m) => Int -> [a] -> m [a]
 sampleNFromList _ [] = return []
@@ -115,28 +124,28 @@ sampleNFromList n xs = replicateM n sample
 
 -- START: Functions that Actions map to --
 play :: Index -> PlayerState -> PlayerState
-play ind ps = ps {board = board ps ++ [findCard ind (hand ps)], hand = remove ind (hand ps)}
+play ind ps = ps {board = ps.board ++ [findCard ind ps.hand], hand = remove ind ps.hand}
 
 buy :: Index -> PlayerState -> PlayerState
 buy ind ps =
-  let cardInstance = findCard ind (shop ps)
-      card = _card cardInstance
-      cost = _baseCost card
-      moneyLeft = curGold ps
+  let cardInstance = findCard ind ps.shop
+      card = cardInstance._card
+      cost = card._baseCost
+      moneyLeft = ps.curGold
    in if cost > moneyLeft
         then
           error "Logic error: Attempted buying without enough money."
-        else ps {curGold = moneyLeft - cost, shop = remove ind (shop ps), hand = hand ps ++ [cardInstance]}
+        else ps {curGold = moneyLeft - cost, shop = remove ind ps.shop, hand = ps.hand ++ [cardInstance]}
 
 sell :: Index -> PlayerState -> PlayerState
-sell ind ps = ps {curGold = curGold ps + 1, board = remove ind (board ps)}
+sell ind ps = ps {curGold = ps.curGold + 1, board = remove ind ps.board}
 
 roll :: (MonadRandom m) => PlayerState -> m PlayerState
 roll ps = do
-  newShop <- randomShop (tier ps)
-  return $ ps {curGold = curGold ps - 1, shop = newShop}
+  newShop <- randomShop ps.tier
+  return $ ps {curGold = ps.curGold - 1, shop = newShop}
 
 tierUp :: PlayerState -> PlayerState
-tierUp ps = ps {curGold = curGold ps - tierUpCost ps, tier = tier ps + 1}
+tierUp ps = ps {curGold = ps.curGold - ps.tierUpCost, tier = ps.tier + 1}
 
 -- END --

src/Model.hs

@@ -4,7 +4,6 @@
 module Model (module Model) where
 
 import Control.Lens hiding (Index)
-import Data.Map (Map)
 import Data.UUID (UUID)
 import System.Random (StdGen)
 
@@ -58,13 +57,15 @@ type UserName = String
 
 data Phase = HeroSelect | Recruit | Combat deriving (Eq)
 
+-- For now, GameState just keeps track of the solo player and one AI.
+data Player = Player | AI
 data GameState = GameState
-  { _playerStates :: Map UserName PlayerState,
+  { playerState :: PlayerState, 
+    aiState :: PlayerState,
     turn :: Turn
   }
 
-data OppInfo = OppInfo {oppHP :: Health, oppArmor :: Armor}
-
+data CombatMoves = CombatMoves
 data PlayerState = PlayerState
   { tier :: TavernTier,
     maxGold :: Gold,
@@ -73,22 +74,21 @@ data PlayerState = PlayerState
     shop :: Shop,
     board :: Board,
     hand :: Hand,
-    phase :: Phase,
     frozen :: Bool,
     hp :: Health,
     armor :: Armor,
     alive :: Bool,
     rerollCost :: Gold,
-    opponentInformation :: Map UserName OppInfo
+    phase :: Phase,
+    combatSequence :: ([CombatMoves], Int)
   }
 
-$(makeLenses ''GameState)
-$(makeLenses ''PlayerState)
-
 data Env = Env
   { gen :: StdGen
   }
 
 type Index = Int
 
-data Action = Buy Index | Sell Index | Play Index | Help | StartGame | EndTurn
+data GameAction = StartGame
+
+data Command = EndTurn | Help | Buy Index | Sell Index | Play Index

src/Utils.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Utils (module Utils) where
+import Model
+
+updatePlayer :: Player -> PlayerState -> GameState -> GameState
+updatePlayer Player ps gs = gs { playerState = ps }
+updatePlayer AI     ps gs = gs { aiState     = ps}
+
+selectPlayer :: Player -> GameState -> PlayerState
+selectPlayer Player gs = gs.playerState
+selectPlayer AI     gs = gs.aiState