From c4cdd6ee78eb66410ec9557836aafe2d211e8615 Mon Sep 17 00:00:00 2001 From: flober Date: Thu, 1 Aug 2024 10:40:25 -0400 Subject: [PATCH] got rid of `validateCommand`: error handling goes directly in the action functions. --- src/Controller.hs | 40 +++++++----- src/Logic.hs | 155 ++++++++++++++++++++-------------------------- src/Model.hs | 4 +- src/Model.md | 2 +- src/Thoughts.md | 7 ++- src/View.hs | 2 +- test/ViewTest.hs | 4 +- 7 files changed, 103 insertions(+), 111 deletions(-) diff --git a/src/Controller.hs b/src/Controller.hs index 4e1fcab..7d31791 100644 --- a/src/Controller.hs +++ b/src/Controller.hs @@ -3,14 +3,13 @@ module Controller (module Controller) where import Card (bigDumbo) -import Control.Monad.Random (MonadRandom (getRandom)) -import Logic (execCommand, isGameOver, validateCommand, enter) +import Control.Monad.Random (MonadRandom (getRandom), MonadIO, liftIO) +import Logic (enter, execCommand, isGameOver) 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) -- START: Functions for ingesting terminal input as PlayerAction -- -- Examples: @@ -28,7 +27,7 @@ interp s = case parse actionParser "" s of -- Parse the full input string actionParser :: Parser Command actionParser = do - cmd <- choice $ map (try . string) ["buy", "b", "sell", "s", "help", "h", "endturn", "e", "play", "p"] + cmd <- choice $ map (try . string) ["buy", "b", "sell", "s", "play", "p", "roll", "r", "freeze", "f", "endturn", "e", "help", "h", "concede"] spaces action <- actionArgumentParser cmd eof @@ -40,8 +39,11 @@ actionArgumentParser cmd | cmd `elem` ["buy", "b"] = buyArgParser | cmd `elem` ["sell", "s"] = sellArgParser | cmd `elem` ["play", "p"] = playArgParser - | cmd `elem` ["help", "h"] = return Help + | cmd `elem` ["roll", "r"] = return Roll + | cmd `elem` ["freeze", "f"] = return Freeze | cmd `elem` ["endturn", "e"] = return EndTurn + | cmd `elem` ["help", "h"] = return Help + | cmd == "concede" = return Concede | otherwise = error "Unexpected path: actionArgumentParser should only run if it matched a command." buyArgParser :: Parser Command @@ -64,12 +66,13 @@ playArgParser = do case readMaybe indStr of Just ind -> return $ Play ind Nothing -> fail "Play's argument should be a valid number." + -- END -- initGameState :: (MonadRandom m) => m GameState initGameState = do tutorialAIGameState <- tutorialAI - return $ GameState {playerState = defPlayerState, aiState=tutorialAIGameState, turn = 0} + return $ GameState {playerState = defPlayerState, aiState = tutorialAIGameState, turn = 0, config = Config { maxBoardSize = 7 }} tutorialAI :: (MonadRandom m) => m PlayerState tutorialAI = do @@ -99,20 +102,23 @@ runGame :: IO () runGame = do gs <- initGameState gs' <- enter Recruit gs - _ <- loop gs' + _ <- loop (return gs') putStrLn "Game Finished." where -- Repeat Recruit and Combat until game over - loop gs = + loop :: (MonadIO m, MonadRandom m) => m GameState -> m GameState + loop mgs = do + gs <- mgs if isGameOver gs then do return gs - else do - putStrLn $ render gs Player - input <- getLine - case interp input >>= (\c -> validateCommand c gs Player) of - Left err -> putStrLn err >> loop gs - Right action' -> do - gs' <- liftIO $ execCommand action' gs Player - loop gs' - + else do + liftIO $ putStrLn $ render gs Player + 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') \ No newline at end of file diff --git a/src/Logic.hs b/src/Logic.hs index 5dd68b8..726caad 100644 --- a/src/Logic.hs +++ b/src/Logic.hs @@ -6,83 +6,49 @@ module Logic (module Logic) where import Card (pool) import Control.Monad.Random +import Data.Functor ((<&>)) import Model -import View ( helpMenu ) import Utils - --- START: Functions interfacing with PlayerAction. -- - --- Can action occur in given PlayerState? Yes then thread the same action through. False then error message. -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 - 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 - 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 - 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 +import View (helpMenu) + +execCommand :: (MonadIO m, MonadRandom m) => Command -> GameState -> Player -> m (Either String GameState) +execCommand (Buy ind) gs p = return $ buy ind (selectPlayer p gs) >>= (\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 _ = enter Combat gs <&> Right +execCommand Roll gs p = do + ps' <- roll $ selectPlayer p gs + return $ liftM2 (updatePlayer p) ps' (return gs) +execCommand _ gs _ = return $ Right gs + +-- Game over if exactly one player is alive isGameOver :: GameState -> Bool isGameOver gs = gs.playerState.alive /= gs.aiState.alive --- Performed when we first transition to a new game phase. +-- Performed when we first transition to a new game phase. 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 - } + newAIState <- replenish gs.aiState + return + gs + { playerState = newPlayerState, + aiState = newAIState + } where 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 - } + 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 PlayerAction Functions -- -- Determinisitc functions should only be used when the usage permits only the happy path @@ -122,29 +88,42 @@ sampleNFromList n xs = replicateM n sample -- END -- --- START: Functions that Actions map to -- -play :: Index -> PlayerState -> PlayerState -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 ps.shop - cost = cardInstance.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 ps.shop, hand = ps.hand ++ [cardInstance]} - -sell :: Index -> PlayerState -> PlayerState -sell ind ps = ps {curGold = ps.curGold + 1, board = remove ind ps.board} - -roll :: (MonadRandom m) => PlayerState -> m PlayerState -roll ps = do - newShop <- randomShop ps.tier - return $ ps {curGold = ps.curGold - 1, shop = newShop} - -tierUp :: PlayerState -> PlayerState -tierUp ps = ps {curGold = ps.curGold - ps.tierUpCost, tier = ps.tier + 1} +-- START: Functions that Command maps to -- +play :: Index -> GameState -> Player -> Either String PlayerState +play ind gs p + | ind < 0 || ind >= length ps.hand || ind >= gs.config.maxBoardSize = Left "Out of bounds." + | otherwise = Right ps {board = ps.board ++ [findCard ind ps.hand], hand = remove ind ps.hand} + where + ps = selectPlayer p gs + +buy :: Index -> PlayerState -> Either String PlayerState +buy ind ps + | shopSize == 0 = Left "Cannot buy. Your shop is empty." + | ind < 0 || ind >= shopSize = Left "Out of bounds." + | cost > moneyLeft = + Left "Attempted buying without enough money." + | otherwise = + Right ps {curGold = moneyLeft - cost, shop = remove ind ps.shop, hand = ps.hand ++ [cardInstance]} + where + cardInstance = findCard ind ps.shop + cost = cardInstance.card.baseCost + moneyLeft = ps.curGold + shopSize = length ps.shop + +sell :: Index -> PlayerState -> Either String PlayerState +sell ind ps + | ind < 0 || ind >= length ps.board = Left "Out of bounds." + | otherwise = Right ps {curGold = ps.curGold + 1, board = remove ind ps.board} + +roll :: (MonadRandom m) => PlayerState -> m (Either String PlayerState) +roll ps = + if ps.curGold < ps.rerollCost + then return $ Left "Attempted rollings without enough money" + else do + newShop <- randomShop ps.tier + return $ Right $ ps {curGold = ps.curGold - 1, shop = newShop} + +-- tierUp :: PlayerState -> PlayerState +-- tierUp ps = ps {curGold = ps.curGold - ps.tierUpCost, tier = ps.tier + 1} -- END -- diff --git a/src/Model.hs b/src/Model.hs index ee973b3..711519b 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -53,9 +53,11 @@ data Phase = HeroSelect | Recruit | Combat deriving (Eq) -- For now, GameState just keeps track of the solo player and one AI. data Player = Player | AI +newtype Config = Config { maxBoardSize :: Int } data GameState = GameState { playerState :: PlayerState, aiState :: PlayerState, + config :: Config, turn :: Turn } @@ -84,7 +86,7 @@ data Command = Buy Index | Sell Index | Play Index - | Refresh + | Roll | Freeze | EndTurn | Help diff --git a/src/Model.md b/src/Model.md index 3f5713d..93382ab 100644 --- a/src/Model.md +++ b/src/Model.md @@ -54,7 +54,7 @@ reroll :: GameState -> GameState reroll (GameState board) = fold (\card -> onReroll card) board ``` -Con: Cards should inform `reroll` if they have special `reroll` behavior that should completely override the default behavior (of subtracting 1 coin and refreshing shop). But special cards can override this behavior. Whether to override the default behavior +Con: Cards should inform `reroll` if they have special `reroll` behavior that should completely override the default behavior (of subtracting 1 coin and rolling shop). But special cards can override this behavior. Whether to override the default behavior is card specific. This is a nuisance. I can technically make everything composable (no overriding) by adjusting `malchezaar`'s affect to "adding 1 gold and subtracting one health", but that's confusing. #### Modelling `Peggy`, `Bream Counter`. diff --git a/src/Thoughts.md b/src/Thoughts.md index 5569594..8f3f2e5 100644 --- a/src/Thoughts.md +++ b/src/Thoughts.md @@ -10,4 +10,9 @@ to issue commands to the server, etc. 3. flush out server stuff, adding game rooms, authentications, etc. Note, server and client will be bidirectionally. Server needs to manage phase timers and ping the client when phase changes. -So, the client needs to `forkIO` twice for a sending and receiving thread. The server can have one `fork` per client. \ No newline at end of file +So, the client needs to `forkIO` twice for a sending and receiving thread. The server can have one `fork` per client. + +### Aug 1, 2024 +Callbacks can be used to implement both in-game logic and game rules. For example, omu's hero power can be implemented via a callback +to `tierUp`. Conversely, maybe `tierUp` can expand the `randomShopSize` via a callback, as opposed to this being built-in. For now, +`randomShop` is directly dependent on `TavernTier`, but maybe that can change. \ No newline at end of file diff --git a/src/View.hs b/src/View.hs index ecd2f80..75cc491 100644 --- a/src/View.hs +++ b/src/View.hs @@ -111,7 +111,7 @@ helpMenu = "| buy or b | Buy card at shop pos |", "| sell or s | Sell minion at board pos |", "| play or p | Play minion at hand pos |", - "| refresh or r | Refresh your tavern |", + "| roll or r | Refresh your tavern |", "| freeze or f | Freeze your tavern |", "| endturn or e | End your turn |", "| help or h | Display this menu |", diff --git a/test/ViewTest.hs b/test/ViewTest.hs index 25ccc50..f4ef280 100644 --- a/test/ViewTest.hs +++ b/test/ViewTest.hs @@ -5,7 +5,7 @@ import Card import Data.List (intercalate) import Data.Maybe (fromJust) import Data.UUID (UUID, fromString) -import Model (CardInstance (..), GameState (..), Phase (..), PlayerState (..), Player (Player)) +import Model import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertEqual, testCase) import View (render) @@ -116,7 +116,7 @@ blankAIState :: PlayerState blankAIState = blankPlayerState {hp = 5, armor = 0} blankGameState :: GameState -blankGameState = GameState {playerState = blankPlayerState, aiState = blankAIState, turn = 0} +blankGameState = GameState {playerState = blankPlayerState, aiState = blankAIState, config = Config {maxBoardSize = 7}, turn = 0} maxItemsGameState :: GameState maxItemsGameState = blankGameState {playerState = maxItemsPlayerState}