initial player setup, buy, sell

src/Controller/Terminal.hs

@@ -1,15 +1,18 @@
 module Controller.Terminal (module Controller.Terminal) where
 
 import Card (bigDumbo)
+import Control.Lens
 import Control.Monad.Random (MonadRandom (getRandom))
 import Data.Map hiding (foldl, map)
-import Model (Action (..), CardInstance (CardInstance), GameState (..), Phase (Blank), PlayerState (..))
+import Data.Maybe (fromJust)
+import Logic (execAction, isGameOver, validateAction)
+import Model (Action (..), CardInstance (CardInstance), GameState (..), Phase (HeroSelect), PlayerState (..), playerStates)
 import Text.Parsec hiding (Error)
 import Text.Parsec.String (Parser)
 import Text.Read (readMaybe)
 import View.Terminal (render)
-import Data.Maybe (fromJust)
-import Logic (validateAction, execAction, isGameOver)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Map as Map
 
 -- START: Functions for ingesting terminal input as Action --
 -- Examples:
@@ -21,13 +24,13 @@ import Logic (validateAction, execAction, isGameOver)
 -- help   -> Help
 interp :: String -> Either String Action
 interp s = case parse actionParser "" s of
-             Left _  -> Left "Unrecognized or incorrectly formatted command. Enter :h for command list."
-             Right a -> Right a
+  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 = do
-  cmd <- choice $ map (try . string) ["buy", "b", "sell", "s", "help", "h", "endturn", "e"]
+  cmd <- choice $ map (try . string) ["buy", "b", "sell", "s", "help", "h", "endturn", "e", "play", "p"]
   spaces
   action <- actionArgumentParser cmd
   eof
@@ -38,6 +41,7 @@ actionArgumentParser :: String -> Parser Action
 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` ["endturn", "e"] = return EndTurn
   | otherwise = error "Unexpected path: actionArgumentParser should only run if it matched a command."
@@ -56,13 +60,18 @@ sellArgParser = do
     Just ind -> return $ Sell ind
     Nothing -> fail "Sell's argument should be a valid number."
 
+playArgParser :: Parser Action
+playArgParser = do
+  indStr <- many1 digit
+  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 {playerStates = fromList [("player", defPlayerState), ("tutorialAI", tutorialAIGameState)], turn = 0}
+  return $ GameState {_playerStates = fromList [("player", defPlayerState), ("tutorialAI", tutorialAIGameState)], turn = 0}
 
 tutorialAI :: (MonadRandom m) => m PlayerState
 tutorialAI = do
@@ -80,7 +89,7 @@ defPlayerState =
       shop = [],
       board = [],
       hand = [],
-      phase = Blank,
+      phase = HeroSelect,
       frozen = False,
       hp = 20,
       armor = 0,
@@ -91,24 +100,23 @@ defPlayerState =
 runGame :: IO ()
 runGame = do
   gs <- initGameState
-  _ <- loop gs
+  initialMainPlayerState <- execAction StartGame ((gs ^. playerStates) Map.! "player")
+  let gs' = gs & playerStates . ix "player" .~ initialMainPlayerState
+  _ <- loop gs'
   putStrLn "Game Finished."
   where
+    -- Repeat Recruit and Combat until game over
     loop gs =
       if isGameOver gs
         then do
           return gs
         else do
-          let mainPlayerState = fromJust $ Data.Map.lookup "player" (playerStates gs)
+          let mainPlayerState = fromJust $ Data.Map.lookup "player" (_playerStates gs)
           putStrLn $ render mainPlayerState
           input <- getLine
-          let action = interp input
-          either
-            (\err -> putStrLn err >> loop gs)
-            ( \action' -> do
-                let action'' = validateAction action' gs
-                gs' <- execAction action'' gs
-                loop gs'
-            )
-            action
+          case interp input >>= (`validateAction` mainPlayerState) of
+            Left err -> putStrLn err >> loop gs
+            Right action' -> do
+              newPlayerState <- liftIO $ execAction action' mainPlayerState
+              loop (gs & playerStates . at "player" ?~ newPlayerState)
 

src/Logic.hs

@@ -6,27 +6,54 @@ module Logic (module Logic) where
 import Card (pool)
 import Control.Lens ((^.))
 import Control.Monad.Random
-import Data.UUID
 import Model
 import View.Terminal (helpMenu)
 
 -- START: Functions interfacing with Action. --
-validateAction :: Action -> GameState -> Action
-validateAction = const
 
-execAction :: (MonadIO m) => Action -> GameState -> m GameState
-execAction (Error msg) gs = liftIO (putStrLn msg) >> return gs
+-- 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
+  | 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
+  | 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
+  | 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
-execAction _ gs = return gs
 
 -- END --
 
 -- START: Game Transition Functions --
 --   Check if only one player alive
 isGameOver :: GameState -> Bool
-isGameOver gs = playersAlive == 1
+isGameOver gs = playersAlive == (1 :: Integer)
   where
-    playersAlive = foldl (\acc ps -> if alive ps then acc + 1 else acc) 0 (playerStates gs)
+    playersAlive = foldl (\acc ps -> if alive ps then acc + 1 else acc) 0 (_playerStates gs)
 
 --   Performed when we first transition to a new game phase.
 enter :: (MonadRandom m) => Phase -> PlayerState -> m PlayerState
@@ -42,23 +69,27 @@ enter Recruit ps = do
       }
   where
     newGold = maxGold ps + 1
-enter Combat _ = undefined
+enter Combat ps = return $ ps { phase = Combat }
 enter _ _ = error "Other phases should not be enterable"
 
 -- END --
 
 -- START: Utility Methods for Action 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
     Nothing -> error "Unexpected path: deterministicLookup should always find."
     Just c -> c
 
-findCard :: UUID -> [CardInstance] -> CardInstance
-findCard cardId instances = deterministicLookup cardId ([(_cardId cardInstance, cardInstance) | cardInstance <- instances])
+findCard :: Index -> [CardInstance] -> CardInstance
+findCard ind instances = instances !! ind
 
-removeCard :: UUID -> [CardInstance] -> [CardInstance]
-removeCard cardId = filter (\ci -> _cardId ci /= cardId)
+remove :: Int -> [a] -> [a]
+remove _ [] = []
+remove 0 (_ : xs) = xs
+remove n (x : xs) = x : remove (n - 1) xs
 
 canTierUp :: PlayerState -> Bool
 canTierUp ps = curGold ps >= tierUpCost ps
@@ -82,23 +113,23 @@ sampleNFromList n xs = replicateM n sample
 
 -- END --
 
--- START: Functions that Actions directly map to --
-play :: UUID -> PlayerState -> PlayerState
-play targetId ps = ps {board = board ps ++ [findCard targetId (hand ps)], hand = removeCard targetId (hand ps)}
+-- 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)}
 
-buy :: UUID -> PlayerState -> PlayerState
-buy targetId ps =
-  let cardInstance = findCard targetId (shop ps)
+buy :: Index -> PlayerState -> PlayerState
+buy ind ps =
+  let cardInstance = findCard ind (shop ps)
       card = _card cardInstance
       cost = _baseCost card
       moneyLeft = curGold ps
    in if cost > moneyLeft
         then
           error "Logic error: Attempted buying without enough money."
-        else ps {curGold = moneyLeft - cost, shop = removeCard targetId (shop ps), hand = hand ps ++ [cardInstance]}
+        else ps {curGold = moneyLeft - cost, shop = remove ind (shop ps), hand = hand ps ++ [cardInstance]}
 
-sell :: UUID -> PlayerState -> PlayerState
-sell targetId ps = ps {curGold = curGold ps + 1, board = removeCard targetId (board ps)}
+sell :: Index -> PlayerState -> PlayerState
+sell ind ps = ps {curGold = curGold ps + 1, board = remove ind (board ps)}
 
 roll :: (MonadRandom m) => PlayerState -> m PlayerState
 roll ps = do

src/Model.hs

@@ -4,7 +4,6 @@
 module Model (module Model) where
 
 import Control.Lens hiding (Index)
-import Control.Lens.TH
 import Data.Map (Map)
 import Data.UUID (UUID)
 import System.Random (StdGen)
@@ -26,7 +25,7 @@ type TavernTier = Int
 
 type CardCost = Int
 
-data CardName = Dummy | Dumber | TriDummy | Dumbo | BigDumbo | KingDumbo | DummyWithALongNameItKeepsGoing deriving Show
+data CardName = Dummy | Dumber | TriDummy | Dumbo | BigDumbo | KingDumbo | DummyWithALongNameItKeepsGoing deriving (Show)
 
 data Card = Card
   { _cardName :: CardName,
@@ -57,14 +56,15 @@ type Turn = Int -- What turn are we on?
 
 type UserName = String
 
-data Phase = HeroSelect | Blank | Recruit | Combat
+data Phase = HeroSelect | Recruit | Combat deriving (Eq)
 
 data GameState = GameState
-  { playerStates :: Map UserName PlayerState,
+  { _playerStates :: Map UserName PlayerState,
     turn :: Turn
   }
 
-data OppInfo = OppInfo {  oppHP :: Health, oppArmor :: Armor }
+data OppInfo = OppInfo {oppHP :: Health, oppArmor :: Armor}
+
 data PlayerState = PlayerState
   { tier :: TavernTier,
     maxGold :: Gold,
@@ -82,11 +82,13 @@ data PlayerState = PlayerState
     opponentInformation :: Map UserName OppInfo
   }
 
+$(makeLenses ''GameState)
+$(makeLenses ''PlayerState)
 
-data Env = Env {
-  gen :: StdGen
-}
+data Env = Env
+  { gen :: StdGen
+  }
 
 type Index = Int
 
-data Action = Buy Index | Sell Index | Play Index | Help | StartGame | EndTurn | Error String
+data Action = Buy Index | Sell Index | Play Index | Help | StartGame | EndTurn

src/View/Terminal.hs

@@ -41,7 +41,6 @@ render :: PlayerState -> String
 render ps =
   case phase ps of
     Recruit -> renderRecruit ps
-    Blank -> "blank todo"
     HeroSelect -> "heroselect todo"
     Combat -> "combat todo"