tagless final approach looks good

src/DesignSketch2.hs

@@ -1,56 +1,136 @@
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 
+import Control.Monad.Except
 import Control.Monad.Random
 import Control.Monad.Reader
-import Data.IORef
 
-class (Monad m) => Avatar m where
-  queryTier :: m Int
-  makeRandom :: m Card
+data Tribe = Murloc | Dragon | Demon | Elemental | Undead | Mech | Naga | MurlocDragon | All | SpellTODO deriving (Eq)
+
+data CounterType
+  = -- Upbeat Frontdrake
+    EndOfTurn
+  | -- Avenge mechanic
+    FriendlyDeaths
+  | -- Tehhys
+    GoldSpent
+  | -- Elise
+    Refresh
+  deriving (Eq)
+
+data CardFilterCriterion = MaxTier Int | Tribe Tribe | IsMinion | NotSelf
+
+data RandomTarget = Hand | Shop | Board
+
+data Per = PerCombat | PerRecruit | PerGame
+
+type EffectError = String
+
+data Stats = Stats Int Int deriving (Eq)
+
+data CardName
+  = GlimGuardian
+  | HarmlessBonehead
+  | CordPuller
+  | Skeleton
+  | Microbot
+  | UpbeatFrontdrake
+  | EnchantedLasso
+  | MisfitDragonling
+  | MoltenRock
+  | PickyEater
+  | DeepseaAngler
+  | AnglersLure
+  | SnailCavalry
+  | RecruitATrainee
+  | BlazingSkyfin
+  | AncestralAutomaton
+  | BrannBronzebeard
+  deriving (Eq)
 
-newtype StateEffect = Summon String
+data StateEffect
+  = -- Stats that will be permanently gained even during combat. E.g., Trusty Pup
+    GainPermStats Stats
+  | -- 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
+  | -- 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
+  | -- E.g., Backstage Security
+    DamageHero Int
+  | -- E.g., Upbeat Frontdrake
+    AddToHand CardInstance
+  | -- E.g., Lasso
+    RemoveFromShop CardInstance
+  | Take CardInstance
+  | -- E.g., Tavern Coin
+    GainGold Int
+  | -- E.g., Brann, Dreamer's Embrace
+    TriggerBattlecry CardInstance
 
-newtype Functionality = Deathrattle [StateEffect]
+data KeywordFunctionality
+  = Taunt
+  | DivineShield
+  | Reborn
+  | Windfury
+  | Deathrattle (forall m. (Avatar m) => m [StateEffect])
+  | StartOfCombat (forall m. (Avatar m) => m [StateEffect])
+  | Battlecry (forall m. (Avatar m) => m [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])
+
+data FunctionalityCombinator
+  = -- Per `Per`, run effect up to `Count` times.
+    UpTo Count Per EventFunctionality
+
+data Functionality
+  = Keyword KeywordFunctionality
+  | Event EventFunctionality
+  | Combinator FunctionalityCombinator
 
 data Card = Card
-  { cardName :: String,
+  { cardName :: CardName,
+    stats :: Stats,
+    tribe :: Tribe,
     functionality :: [Functionality]
   }
 
--- Example conversion of one of the cards
-randomSummoner :: (Avatar m) => m Card
-randomSummoner = do
-  c <- makeRandom
-  return $
-    Card
-      "randomSummoner"
-      [Deathrattle [Summon (cardName c)]]
+data CardInstance = CardInstance {card :: Card, instanceId :: Int}
 
-data GameState = GameState {gameTier :: 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 GameState = GameState {}
 
--- Real game instance
 newtype GameM a = GameM (ReaderT GameState (RandT StdGen IO) a)
   deriving (Functor, Applicative, Monad, MonadRandom, MonadIO)
 
-instance Avatar GameM where
-  queryTier = GameM $ asks gameTier
-  makeRandom = do
-    tier <- queryTier
-    cards <- GameM $ asks (cardsInPool . filterByTier tier)
-    -- getRandomR from MonadRandom
-    i <- getRandomR (0, length cards - 1)
-    pure $ cards !! i
-
-filterByTier :: Int -> GameState -> b0
-filterByTier = _
-
-cardsInPool :: b0 -> [Card]
-cardsInPool = _
-
--- Test instance
 data TestConfig = TestConfig
   { mockTier :: Int,
     mockCards :: [Card], -- Default sequence
@@ -60,20 +140,6 @@ data TestConfig = TestConfig
 newtype TestM a = TestM (ReaderT TestConfig IO a)
   deriving (Functor, Applicative, Monad, MonadIO)
 
-instance Avatar TestM where
-  queryTier = TestM $ asks mockTier
-  makeRandom =
-    TestM $
-      asks mockCards >>= \case
-        (c : cs) -> do
-          -- Update remaining cards for next call
-          liftIO $ modifyIORef' cardsRef (const cs)
-          pure c
-        [] -> asks mockCardGen <*> queryTier
-
-cardsRef :: IORef [Card]
-cardsRef = _
-
 -- Example usage:
 runGame :: GameM a -> GameState -> IO a
 runGame (GameM m) gs = do
@@ -83,17 +149,167 @@ runGame (GameM m) gs = do
 runTest :: TestM a -> TestConfig -> IO a
 runTest (TestM m) = runReaderT m
 
--- Example test
-testRandomSummoner :: IO ()
-testRandomSummoner = do
-  let config =
-        TestConfig
-          { mockTier = 2,
-            mockCards = [Card "predetermined1" [], Card "predetermined2" []],
-            mockCardGen = \tier -> Card ("generated" ++ show tier) []
-          }
+glimGuardian :: Card
+glimGuardian = Card GlimGuardian (Stats 1 4) Dragon [Event $ OnAttack (return [GainStats (Stats 2 1)])]
+
+skeleton :: Card
+skeleton = Card Skeleton (Stats 1 1) Undead []
+
+harmlessBonehead :: Card
+harmlessBonehead = Card HarmlessBonehead (Stats 1 1) Undead [Keyword $ Deathrattle (return [Summon Skeleton, Summon Skeleton])]
+
+microbot :: Card
+microbot = Card Microbot (Stats 1 1) Mech []
+
+cordPuller :: Card
+cordPuller = Card CordPuller (Stats 1 1) Mech [Keyword DivineShield, Keyword $ Deathrattle (return [Summon Microbot])]
+
+upbeatFrontdrake :: Card
+upbeatFrontdrake =
+  Card
+    UpbeatFrontdrake
+    (Stats 1 1)
+    Dragon
+    [ Event $
+        Every
+          3
+          EndOfTurn
+          ( do
+              t <- queryTier
+              c <- makeRandomCard [MaxTier t, Tribe Dragon]
+              return [AddToHand c]
+          )
+    ]
+
+-- Look mom! Tavern spells can be modeled as a minion. But a Spell type is absolutely needed in later versions
+enchantedLasso :: Card
+enchantedLasso =
+  Card
+    EnchantedLasso
+    (Stats 0 0)
+    SpellTODO
+    [ Keyword $
+        Battlecry
+          ( do
+              ci <- targetRandomCard Shop [IsMinion]
+              return [Take ci]
+          )
+    ]
+
+misfitDragonling :: Card
+misfitDragonling =
+  Card
+    MisfitDragonling
+    (Stats 2 1)
+    Dragon
+    [ Keyword $
+        StartOfCombat
+          ( do
+              t <- queryTier
+              return [GainStats (Stats t t)]
+          )
+    ]
+
+anglersLure :: Card
+anglersLure =
+  Card
+    AnglersLure
+    (Stats 0 0)
+    SpellTODO
+    [ Keyword $
+        Battlecry
+          (return [GainTempStats (Stats 0 2), GainTempTaunt])
+    ]
+
+deepseaAngler :: Card
+deepseaAngler =
+  Card
+    DeepseaAngler
+    (Stats 2 2)
+    Naga
+    [ Keyword $ Spellcraft anglersLure
+    ]
+
+moltenRock :: Card
+moltenRock =
+  Card
+    MoltenRock
+    (Stats 3 3)
+    Elemental
+    [ Event $
+        AfterPlay
+          ( do
+              c <- retrieveAssociatedCard
+              return $ [GainStats (Stats 0 1) | (tribe . card) c == Elemental]
+          )
+    ]
+
+pickyEater :: Card
+pickyEater =
+  Card
+    PickyEater
+    (Stats 1 1)
+    Demon
+    [ Keyword $
+        Battlecry
+          ( do
+              toEat <- targetRandomCard Shop [IsMinion] -- pickEater's battlecry should fail if there is nothing to eat!
+              return [RemoveFromShop toEat, GainStats (stats (card toEat))]
+          )
+    ]
+
+snailCavalry :: Card
+snailCavalry =
+  Card
+    SnailCavalry
+    (Stats 2 2)
+    Naga
+    [ Combinator $
+        UpTo
+          1
+          PerRecruit
+          ( AfterPlay
+              ( do
+                  c <- retrieveAssociatedCard
+                  return [GainStats (Stats 1 1) | (tribe . card) c == SpellTODO]
+              )
+          )
+    ]
+
+recruitATrainee :: Card
+recruitATrainee =
+  Card
+    RecruitATrainee
+    (Stats 0 0)
+    SpellTODO
+    [ Keyword $
+        Battlecry
+          ( do
+              c <- makeRandomCard [MaxTier 1]
+              return [AddToHand c]
+          )
+    ]
 
-  result <- runTest (functionality randomSummoner) config
-  _
+blazingSkyfin :: Card
+blazingSkyfin =
+  Card
+    BlazingSkyfin
+    (Stats 2 4)
+    MurlocDragon
+    [ Event $
+        AfterBattlecryTrigger (return [GainStats (Stats 1 1)])
+    ]
 
--- Assert on result
+ancestralAutomaton :: Card
+ancestralAutomaton =
+  Card
+    AncestralAutomaton
+    (Stats 2 5)
+    Mech
+    [ Event $
+        AfterSummon
+          ( do
+              c <- retrieveAssociatedCard
+              return [GainPermStats (Stats 2 1) | cardName (card c) == AncestralAutomaton]
+          )
+    ]