diff --git a/README.md b/README.md index 5bfbfec..848fb67 100644 --- a/README.md +++ b/README.md @@ -11,6 +11,6 @@ when `Model.hs` is open. ### Roadmap 1. [x] Basic Game Loop. -2. [ ] Support all Tier 1 cards. The hardest to implement would be Scallywag. +2. [ ] Support the follow cards in this order: A God Card (responds to all events), Harmless Bonehead, Picky Eater, Upbeat Frontdrake, Dune Dweller 3. [ ] Support all cards, completing the single player mode experience. 4. [ ] Server, game rooms, authentication. \ No newline at end of file diff --git a/docs/Thoughts.md b/docs/Thoughts.md index 00d38dc..1e3de4b 100644 --- a/docs/Thoughts.md +++ b/docs/Thoughts.md @@ -95,3 +95,40 @@ Snail Cavalry requires this, but with both `UpTo` and `AfterPlay` being Resolution: - Split `Functionalities` into `KeywordFunctionality`, `EventFunctionality`, and `FunctionalityCombinator`. + +### Oct 21, 2024: +Question: How to model Brann? + +Idea 1: `AfterBattlecryTrigger`. But this would require `AfterBattlecryTrigger` to pass in the `TriggeredBattlecry`, and a new `TriggerBattlecry` state effect. + +Idea 2: Reserved `BrannFunctionality`. + +Idea 3: Reserved `Trigger Battlecry Times` constructor for `Functionality`. + +Idea 4: The game logic keeps an priority queue for how many times do battlecries get triggered, +it's a priority queue because the highest trigger count is used. Brann, upon entering the board, +inserts "twice" into the battlecry priority queue. On leave, it deletes *some* "Battlecry twice" node. + +### Oct 26, 2024: +Problem: `retrieveAssociatedCard` is not good correctness by modeling since +a lot of events are not associated cards. + +Solution: +#1: For events, it probably makes the most sense to just pass the associated card +#2: To be fancy, we could associate `retrieveAssociatedCard` with a typeclass that +only `EventFunctionalities` get access to. That still seems too much though. + +---- + +Idea: What if I free monadized the design sketch more and delistified the `[Functionality]` that is bound to a `Card`? + +---- + +Idea: What if every Functionality is its own datatype? And, whether or not +it is associated with "keyword", "event", or is a "combinator" +will be described by a `Has` or `Is` style typeclass? + +--- + +Key question: Battlecry effects sometimes have a target, but this target gets +randomized if the effect is to be triggered. How to model this scenario? \ No newline at end of file diff --git a/src/DesignSketch.hs b/docs/sketches/DesignSketch.hs similarity index 58% rename from src/DesignSketch.hs rename to docs/sketches/DesignSketch.hs index b0bddc2..e09626b 100644 --- a/src/DesignSketch.hs +++ b/docs/sketches/DesignSketch.hs @@ -5,7 +5,7 @@ module DesignSketch (module DesignSketch) where import Control.Monad.Free -data CardFilterCriterion = MaxTier Int | Tribe Tribe | IsMinion +data CardFilterCriterion = MaxTier Int | Tribe Tribe | IsMinion | NotSelf data RandomTarget = Hand | Shop | Board @@ -14,6 +14,8 @@ data InjectAvatarMethod next | MakeRandomCard [CardFilterCriterion] (CardInstance -> next) | TargetRandomCard RandomTarget [CardFilterCriterion] (Either EffectError CardInstance -> next) | TargetRandomCards RandomTarget [CardFilterCriterion] Int (Either EffectError [CardInstance] -> next) + | RetrieveAssociatedCard (CardInstance -> next) + | RetrieveBoard ([CardInstance] -> next) deriving (Functor) type InjectAvatar a = Free InjectAvatarMethod a @@ -30,13 +32,24 @@ targetRandomCard randTarget crits = liftF $ TargetRandomCard randTarget crits id targetRandomCards :: RandomTarget -> [CardFilterCriterion] -> Int -> InjectAvatar (Either EffectError [CardInstance]) targetRandomCards randomTarget crits count = liftF $ TargetRandomCards randomTarget crits count id +retrieveAssociatedCard :: InjectAvatar CardInstance +retrieveAssociatedCard = liftF $ RetrieveAssociatedCard id + +retrieveBoard :: InjectAvatar [CardInstance] +retrieveBoard = liftF $ RetrieveBoard id + data StateEffect - = -- E.g., Trusty Pup + = -- Stats that will be permanently gained even during combat. E.g., Trusty Pup GainPermStats Stats - | -- E.g., Stats gained during Combat (Glim Guardian); Spellcraft + | -- Stats that will be permanent if gained during recruit, and temporary if gained during combat. E.g., Blazing Skyfin + GainStats Stats + | -- Stats that is only temporarily gained no matter what. E.g., Spellcraft. GainTempStats Stats - | -- E.g., Ancestral Automaton, Eternal Knight, (Maybe) Deep Blue - GainBaseStats Stats + | -- Stats that is permanently gained for all future instances. E.g., Ancestral Automaton, Eternal Knight + GainStatsForAll Stats + | -- Reserved for deep blue. TODO: Is there a way to factor this into the current gain stat schemes? + GainStatsDeepBlue Stats + | GainTempTaunt | GainTaunt | -- E.g., Cord Puller Summon CardName @@ -49,8 +62,10 @@ data StateEffect | Take CardInstance | -- E.g., Tavern Coin GainGold Int + | -- E.g., Brann, Dreamer's Embrace + TriggerBattlecry CardInstance -data Tribe = Murloc | Dragon | Demon | Elemental | Undead | Mech | Naga | SpellTODO deriving (Eq) +data Tribe = Murloc | Dragon | Demon | Elemental | Undead | Mech | Naga | MurlocDragon | All | SpellTODO deriving (Eq) data CounterType = -- Upbeat Frontdrake @@ -80,15 +95,16 @@ data KeywordFunctionality | Spellcraft Card data EventFunctionality - = -- Events detectable by "inspecting" the card itself + = -- Self events: Detectable by "inspecting" the card itself OnAttack (InjectAvatar (Either EffectError [StateEffect])) | OnDamaged (InjectAvatar (Either EffectError [StateEffect])) | OnKill (InjectAvatar (Either EffectError [StateEffect])) | OnSell (InjectAvatar (Either EffectError [StateEffect])) - | -- Events that are detectable only by listening onto some other more "global" events - AfterPlay (Card -> Bool) (InjectAvatar (Either EffectError [StateEffect])) - | AfterSummon (Card -> Bool) (InjectAvatar (Either EffectError [StateEffect])) - | -- Every `count` times `counterType` happens, run effects + | -- Global events: Detectable by listening onto some other more "global" events + AfterPlay (InjectAvatar (Either EffectError [StateEffect])) + | AfterSummon (InjectAvatar (Either EffectError [StateEffect])) + | AfterBattlecryTrigger (InjectAvatar (Either EffectError [StateEffect])) -- due to cards like Rylak, Dreamer's Embrace, this needs its own event. + | -- Every `count` times `counterType` happens, run effects. `counterType` are more global events. Every Count CounterType (InjectAvatar (Either EffectError [StateEffect])) data FunctionalityCombinator @@ -116,6 +132,10 @@ data CardName | DeepseaAngler | AnglersLure | SnailCavalry + | RecruitATrainee + | BlazingSkyfin + | AncestralAutomaton + | BrannBronzebeard deriving (Eq) data Card = Card @@ -125,10 +145,13 @@ data Card = Card functionality :: [Functionality] } -newtype CardInstance = CardInstance {card :: Card} +data CardInstance = CardInstance {card :: Card, instanceId :: Int} + +instance Eq CardInstance where + a == b = instanceId a == instanceId b glimGuardian :: Card -glimGuardian = Card GlimGuardian (Stats 1 4) Dragon [Event $ OnAttack (return $ Right [GainTempStats (Stats 2 1)])] +glimGuardian = Card GlimGuardian (Stats 1 4) Dragon [Event $ OnAttack (return $ Right [GainStats (Stats 2 1)])] skeleton :: Card skeleton = Card Skeleton (Stats 1 1) Undead [] @@ -184,7 +207,7 @@ misfitDragonling = StartOfCombat ( do t <- queryTier - return $ Right [GainTempStats (Stats t t)] + return $ Right [GainStats (Stats t t)] ) ] @@ -199,7 +222,7 @@ anglersLure = ( return $ Right [ GainTempStats (Stats 0 2), - GainTaunt + GainTempTaunt ] ) ] @@ -214,7 +237,18 @@ deepseaAngler = ] moltenRock :: Card -moltenRock = Card MoltenRock (Stats 3 3) Elemental [Event $ AfterPlay (\card -> tribe card == Elemental) (return $ Right [GainPermStats (Stats 0 1)])] +moltenRock = + Card + MoltenRock + (Stats 3 3) + Elemental + [ Event $ + AfterPlay + ( do + c <- retrieveAssociatedCard + return $ Right [GainStats (Stats 0 1) | (tribe . card) c == Elemental] + ) + ] pickyEater :: Card pickyEater = @@ -226,7 +260,7 @@ pickyEater = Battlecry ( do toEat <- targetRandomCard Shop [IsMinion] -- pickEater's battlecry should fail if there is nothing to eat! - either (return . Left) (\ci -> return $ Right [RemoveFromShop ci, GainPermStats (stats (card ci))]) toEat + either (return . Left) (\ci -> return $ Right [RemoveFromShop ci, GainStats (stats (card ci))]) toEat ) ] @@ -240,6 +274,71 @@ snailCavalry = UpTo 1 PerRecruit - ( AfterPlay (\c -> tribe c == SpellTODO) (return $ Right [GainPermStats (Stats 1 1)]) + ( AfterPlay + ( do + c <- retrieveAssociatedCard + return $ Right [GainStats (Stats 1 1) | (tribe . card) c == SpellTODO] + ) ) - ] \ No newline at end of file + ] + +recruitATrainee :: Card +recruitATrainee = + Card + RecruitATrainee + (Stats 0 0) + SpellTODO + [ Keyword $ + Battlecry + ( do + c <- makeRandomCard [MaxTier 1] + return $ Right [AddToHand c] + ) + ] + +blazingSkyfin :: Card +blazingSkyfin = + Card + BlazingSkyfin + (Stats 2 4) + MurlocDragon + [ Event $ + AfterBattlecryTrigger (return $ Right [GainStats (Stats 1 1)]) + ] + +ancestralAutomaton :: Card +ancestralAutomaton = + Card + AncestralAutomaton + (Stats 2 5) + Mech + [ Event $ + AfterSummon + ( do + c <- retrieveAssociatedCard + return $ Right [GainPermStats (Stats 2 1) | cardName (card c) == AncestralAutomaton] + ) + ] + +data Free' t a + = Pure' a -- Termination case + | Free' -- Recursive nesting of language, store an outer monadic action that keeps another continuation action inside. + ( t -- Algebra of the language + (Free' t a) -- Nested language in the free form. + ) + +-- brannBronzebeard :: Card +-- brannBronzebeard = +-- Card +-- BrannBronzebeard +-- (Stats 2 4) +-- Neutral +-- [ Event $ +-- AfterBattlecryTrigger +-- ( do +-- c <- retrieveAssociatedCard +-- b <- retrieveBoard +-- -- Only do brann stuff if this is the first brann. Brann effects do not stack. +-- return _ +-- ) +-- ] diff --git a/src/DesignSketch2.hs b/docs/sketches/DesignSketch2.hs similarity index 75% rename from src/DesignSketch2.hs rename to docs/sketches/DesignSketch2.hs index d1425fe..523442a 100644 --- a/src/DesignSketch2.hs +++ b/docs/sketches/DesignSketch2.hs @@ -3,10 +3,19 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} - +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilies #-} + +module DesignSketch2 where + import Control.Monad.Except -import Control.Monad.Random import Control.Monad.Reader +import Effectful +import Effectful.Error.Static +import Effectful.Dispatch.Dynamic data Tribe = Murloc | Dragon | Demon | Elemental | Undead | Mech | Naga | MurlocDragon | All | SpellTODO deriving (Eq) @@ -49,6 +58,7 @@ data CardName | BlazingSkyfin | AncestralAutomaton | BrannBronzebeard + | DummyCard deriving (Eq) data StateEffect @@ -83,22 +93,22 @@ data KeywordFunctionality | DivineShield | Reborn | Windfury - | Deathrattle (forall m. (Avatar m) => m [StateEffect]) - | StartOfCombat (forall m. (Avatar m) => m [StateEffect]) - | Battlecry (forall m. (Avatar m) => m [StateEffect]) + | Deathrattle (forall es. (Avatar :> es) => Eff es [StateEffect]) + | StartOfCombat (forall es. (Avatar :> es) => Eff es [StateEffect]) + | Battlecry (forall es. (Avatar :> es) => Eff es [StateEffect]) | Spellcraft Card type Count = Int data EventFunctionality - = OnAttack (forall m. (Avatar m) => m [StateEffect]) - | OnDamaged (forall m. (Avatar m) => m [StateEffect]) - | OnKill (forall m. (Avatar m) => m [StateEffect]) - | OnSell (forall m. (Avatar m) => m [StateEffect]) - | AfterPlay (forall m. (Avatar m) => m [StateEffect]) - | AfterSummon (forall m. (Avatar m) => m [StateEffect]) - | AfterBattlecryTrigger (forall m. (Avatar m) => m [StateEffect]) - | Every Count CounterType (forall m. (Avatar m) => m [StateEffect]) + = OnAttack (forall es. (Avatar :> es) => Eff es [StateEffect]) + | OnDamaged (forall es. (Avatar :> es) => Eff es [StateEffect]) + | OnKill (forall es. (Avatar :> es) => Eff es [StateEffect]) + | OnSell (forall es. (Avatar :> es) => Eff es [StateEffect]) + | AfterPlay (forall es. (Avatar :> es) => Eff es [StateEffect]) + | AfterSummon (forall es. (Avatar :> es) => Eff es [StateEffect]) + | AfterBattlecryTrigger (forall es. (Avatar :> es) => Eff es [StateEffect]) + | Every Count CounterType (forall es. (Avatar :> es) => Eff es [StateEffect]) data FunctionalityCombinator = -- Per `Per`, run effect up to `Count` times. @@ -118,13 +128,34 @@ data Card = Card data CardInstance = CardInstance {card :: Card, instanceId :: Int} -class (Monad m, MonadError EffectError m) => Avatar m where - queryTier :: m Int - makeRandomCard :: [CardFilterCriterion] -> m CardInstance - targetRandomCard :: RandomTarget -> [CardFilterCriterion] -> m CardInstance - targetRandomCards :: RandomTarget -> [CardFilterCriterion] -> Int -> m [CardInstance] - retrieveAssociatedCard :: m CardInstance - retrieveBoard :: m [CardInstance] +data Avatar :: Effect where + QueryTier :: Avatar m Int + MakeRandomCard :: [CardFilterCriterion] -> Avatar m CardInstance + TargetRandomCard :: RandomTarget -> [CardFilterCriterion] -> Avatar m CardInstance + TargetRandomCards :: RandomTarget -> [CardFilterCriterion] -> Int -> Avatar m [CardInstance] + RetrieveAssociatedCard :: Avatar m CardInstance + RetrieveBoard :: Avatar m [CardInstance] + +type instance DispatchOf Avatar = Dynamic + + +queryTier :: Avatar :> es => Eff es Int +queryTier = send QueryTier + +makeRandomCard :: Avatar :> es => [CardFilterCriterion] -> Eff es CardInstance +makeRandomCard = send . MakeRandomCard + +targetRandomCard :: Avatar :> es => RandomTarget -> [CardFilterCriterion] -> Eff es CardInstance +targetRandomCard target = send . TargetRandomCard target + +targetRandomCards :: Avatar :> es => RandomTarget -> [CardFilterCriterion] -> Int -> Eff es [CardInstance] +targetRandomCards target criteria = send . TargetRandomCards target criteria + +retrieveAssociatedCard :: Avatar :> es => Eff es CardInstance +retrieveAssociatedCard = send RetrieveAssociatedCard + +retrieveBoard :: Avatar :> es => Eff es [CardInstance] +retrieveBoard = send RetrieveBoard data GameState = GameState {} diff --git a/docs/sketches/GameInterpreter.hs b/docs/sketches/GameInterpreter.hs new file mode 100644 index 0000000..7efdde5 --- /dev/null +++ b/docs/sketches/GameInterpreter.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + +module GameInterpreter where + +import Control.Monad +import DesignSketch2 hiding (GameM, GameState) +import Effectful +import Effectful.Error.Static +import Effectful.State.Static.Local +import RNGDesign (GameRNG(..)) +import Effectful.Dispatch.Dynamic + +-- A minimal game state that can handle PickyEater's battlecry +data GameState = GameState + { playerHand :: [CardInstance] + , playerBoard :: [CardInstance] + , shop :: [CardInstance] + , currentTier :: Int + } + +-- All effects +type GameM = Eff '[State GameState, Error EffectError, Avatar, GameRNG] +type instance DispatchOf GameRNG = Dynamic + +-- Avatar handler as opposed to instance Avatar methods. +runAvatar :: (State GameState :> es, Error EffectError :> es, GameRNG :> es) => Avatar m a -> Eff es a +runAvatar = \case + QueryTier -> get >>= pure . currentTier + + TargetRandomCard Shop criteria -> do + shopCards <- gets shop + case shopCards of + [] -> throwError "No cards in shop" + cards -> do + idx <- send $ ChooseFromShop (length cards) + pure $ cards !! idx + + TargetRandomCards target criteria n -> do + cards <- case target of + Shop -> gets shop + Board -> gets playerBoard + Hand -> gets playerHand + if length cards < n + then throwError "Not enough cards to choose from" + else replicateM n $ do + idx <- send $ ChooseFromShop (length cards) + pure $ cards !! idx + + MakeRandomCard _ -> throwError "Not implemented" + RetrieveAssociatedCard -> throwError "Not implemented" + RetrieveBoard -> gets playerBoard + +-- Interpret a single StateEffect +interpretEffect :: (State GameState :> es, Error EffectError :> es, GameRNG :> es) + => StateEffect -> Eff es () +interpretEffect = \case + Take card -> do + st <- get + let newShop = filter (\c -> instanceId c /= instanceId card) (shop st) + let newHand = card : playerHand st + put st { shop = newShop, playerHand = newHand } + + GainStats stats -> return () + + _ -> throwError "Effect not implemented" + +-- Run a card's battlecry effect +runBattlecry :: (State GameState :> es, Error EffectError :> es, GameRNG :> es, Avatar :> es) + => CardInstance -> Eff es () +runBattlecry ci = case card ci of + Card {functionality = fs} -> do + let battlecries = [b | Keyword (Battlecry b) <- fs] + forM_ battlecries $ \battlecry -> do + effects <- battlecry + mapM_ interpretEffect effects + +-- Main game action for playing a card +playCard :: CardInstance -> GameM () +playCard ci = do + -- First move the card from hand to board + st <- get + let newHand = filter (\c -> instanceId c /= instanceId ci) (playerHand st) + let newBoard = ci : playerBoard st + put st { playerHand = newHand, playerBoard = newBoard } + + -- Then trigger its battlecry if it has one + runBattlecry ci + +-- Helper to run the game monad +-- runGame :: GameM a -> GameState -> IO (Either EffectError a) +-- runGame m initialState = +-- runEff $ +-- runError @EffectError $ +-- evalState initialState $ +-- runGameRNG $ -- Add GameRNG handler +-- runAvatar' $ -- Add Avatar handler +-- m + +-- Example initial game state for testing +initialGameState :: GameState +initialGameState = GameState + { playerHand = [CardInstance pickyEater 1] -- PickyEater with ID 1 + , playerBoard = [] + , shop = [CardInstance (Card DummyCard (Stats 2 2) Demon []) 2] -- Using DummyCard constructor + , currentTier = 1 + } + +-- Add a dummy Avatar handler (you'll need to implement this properly) +runAvatar' :: (State GameState :> es, Error EffectError :> es, GameRNG :> es) + => Eff (Avatar ': es) a -> Eff es a +runAvatar' = interpret $ \_ -> undefined -- Implement proper Avatar handling \ No newline at end of file diff --git a/docs/sketches/RNGDesign.hs b/docs/sketches/RNGDesign.hs new file mode 100644 index 0000000..874983c --- /dev/null +++ b/docs/sketches/RNGDesign.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + +module RNGDesign where + +import Control.Monad.Identity (Identity) +import Control.Monad.State (StateT) +import DesignSketch2 +import Effectful +import Effectful.Dispatch.Dynamic +import Effectful.Dispatch.Static +import Effectful.State.Static.Local +import System.Random (randomRIO) + +-- import Effectful.Internal.Utils (unsafeEff_) + +data PlayerState = PlayerState + +data Result = Result deriving (Show) + +data GameRNG :: Effect where + ChooseFirstAttacker :: GameRNG m Int + ChooseDefendingMinion :: Int -> GameRNG m Int + ChooseFromShop :: Int -> GameRNG m Int + +type instance DispatchOf GameRNG = Dynamic + +-- Real RNG Effect Handler is implemented with System.Random +runGameRNG :: (IOE :> es) => Eff (GameRNG : es) a -> Eff es a +runGameRNG = interpret $ \_ -> \case + ChooseFirstAttacker -> liftIO $ randomRIO (0, 1) + ChooseDefendingMinion n -> liftIO $ randomRIO (0, n - 1) + +data MockRNGSources = MockRNGSources + { firstAttackerChoices :: [Int], + defendingMinionChoices :: [Int] + } + +-- Mock RNG Effect Handler is implemented by taking in a concrete mock product +runGameRNGMock :: MockRNGSources -> Eff (GameRNG : es) a -> Eff es a +runGameRNGMock initial = + reinterpret + (evalState initial) + ( \_ -> \case + ChooseFirstAttacker -> do + s <- get + case firstAttackerChoices s of + (x : xs) -> do + put (s {firstAttackerChoices = xs}) + pure x + [] -> error "No more mock values for first attacker" + ChooseDefendingMinion _ -> do + s <- get + case defendingMinionChoices s of + (x : xs) -> do + put (s {defendingMinionChoices = xs}) + pure x + [] -> error "No more mock values for defending minion" + ) + +-- Our main fight function using the effect +fight1 :: (GameRNG :> es) => PlayerState -> PlayerState -> Eff es Result +fight1 _p1 _p2 = do + _firstPlayer <- send ChooseFirstAttacker + unsafeEff_ $ putStrLn $ "First player chosen: " ++ show _firstPlayer + + _defender1 <- send $ ChooseDefendingMinion 5 + unsafeEff_ $ putStrLn $ "First defender chosen: " ++ show _defender1 + + _defender2 <- send $ ChooseDefendingMinion 3 + unsafeEff_ $ putStrLn $ "Second defender chosen: " ++ show _defender2 + + pure Result + +fightWithRealRNG :: PlayerState -> PlayerState -> IO Result +fightWithRealRNG p1 p2 = + runEff $ + runGameRNG $ + fight1 p1 p2 + +-- Example usage with mock values for testing +fightWithMockRNG :: PlayerState -> PlayerState -> Result +fightWithMockRNG p1 p2 = + runPureEff $ + runGameRNGMock MockRNGSources {firstAttackerChoices = [0, 2, 1], defendingMinionChoices = [0, 2, 1]} $ + fight1 p1 p2 + +interp :: KeywordFunctionality -> StateT PlayerState Identity () +interp (Battlecry a) = return () +