Reworked the way abilities and alternative costs work

Magic-Cards/src/Magic/BasicLands.hs

@@ -26,8 +26,8 @@ mkBasicLandCard ty color = mkCard $ do
   play               =: Just playLand
   activatedAbilities =: [tapToAddMana (Just color)]
 
-playLand :: ActivatedAbility
-playLand = ActivatedAbility
+playLand :: Activation
+playLand = Activation
   { available = \rSource rActivator ->
       case rSource of
         (Some (Hand _), _) -> do
@@ -40,9 +40,7 @@ playLand = ActivatedAbility
           return (control && ap == rActivator && step == MainPhase && stackEmpty && n < 1)
         _           -> return False
   , manaCost = mempty
-  , tapCost = NoTapCost
   , effect = \rSource rActivator -> void (executeEffect (Will (PlayLand rActivator rSource)))
-  , abilityType = ActivatedAb
   }
 
 countLandsPlayedThisTurn :: (PlayerRef -> Bool) -> View Int
@@ -54,15 +52,17 @@ countLandsPlayedThisTurn f = length . filter isPlayLand <$> asks turnHistory
 
 tapToAddMana :: Maybe Color -> ActivatedAbility
 tapToAddMana mc = ActivatedAbility
-  { available = \rSource rActivator ->
-      case rSource of
-        (Some Battlefield, _) ->
-          checkObject rSource (isControlledBy rActivator)
-        _ -> return False
-  , manaCost = mempty
-  , tapCost = TapCost
-  , effect = \_rSource rActivator -> void (executeEffect (Will (AddToManaPool rActivator [mc])))
+  { abilityActivation = Activation
+    { available = \rSource rActivator ->
+        case rSource of
+          (Some Battlefield, _) ->
+            checkObject rSource (isControlledBy rActivator)
+          _ -> return False
+    , manaCost = mempty
+    , effect = \_rSource rActivator -> void (executeEffect (Will (AddToManaPool rActivator [mc])))
+    }
   , abilityType = ManaAb
+  , tapCost = TapCost
   }
 
 checkObject :: SomeObjectRef -> (Object -> Bool) -> View Bool

Magic-Cards/src/Magic/M13.hs

@@ -56,13 +56,11 @@ angel'sMercy :: Card
 angel'sMercy = mkCard $ do
   name =: Just "Angel's Mercy"
   types =: instantType
-  play =: Just ActivatedAbility
+  play =: Just Activation
     { available       = instantSpeed
     , manaCost        = [Nothing, Nothing, Just White, Just White]
-    , tapCost         = NoTapCost
     , effect          = \rSelf rActivator -> stackTargetlessEffect rSelf $ \_ ->
       void $ executeEffect (Will (GainLife rActivator 7))
-    , abilityType     = ActivatedAb
     }
 
 angelicBenediction :: Card
@@ -176,15 +174,13 @@ captain'sCall :: Card
 captain'sCall = mkCard $ do
   name  =: Just "Captain's Call"
   types =: sorceryType
-  play  =: Just ActivatedAbility
+  play  =: Just Activation
     { available       = sorcerySpeed
     , manaCost        = [Nothing, Nothing, Nothing, Just White]
-    , tapCost         = NoTapCost
     , effect          = \rSelf rActivator -> do
         t <- tick
         stackTargetlessEffect rSelf $
           \_ -> void $ executeEffects $ replicate 3 $ mkSoldierEffect t rActivator
-    , abilityType     = ActivatedAb
     }
 
 divineFavor :: Card
@@ -225,12 +221,10 @@ searingSpear :: Card
 searingSpear = mkCard $ do
     name  =: Just "Searing Spear"
     types =: instantType
-    play  =: Just ActivatedAbility
+    play  =: Just Activation
       { available     = instantSpeed
       , manaCost      = [Nothing, Just Red]
-      , tapCost       = NoTapCost
       , effect        = searingSpearEffect
-      , abilityType   = ActivatedAb
       }
   where
     searingSpearEffect :: Contextual (Magic ())
@@ -293,13 +287,15 @@ simpleCreatureToken t you tys cs pt' =
 
 loyaltyAbility :: Int -> Contextual (Magic ()) -> ActivatedAbility
 loyaltyAbility cost eff = ActivatedAbility
-  { available = sorcerySpeed &&* hasAtLeastLoyalty cost
-  , manaCost = []
+  { abilityActivation = Activation
+    { available = sorcerySpeed &&* hasAtLeastLoyalty cost
+    , manaCost = []
+    , effect = \rSelf you -> do
+        void $ executeEffects (replicate cost (Will (RemoveCounter rSelf Loyalty)))
+        eff rSelf you
+    }
   , tapCost = NoTapCost
-  , abilityType = ActivatedAb
-  , effect = \rSelf you -> do
-      void $ executeEffects (replicate cost (Will (RemoveCounter rSelf Loyalty)))
-      eff rSelf you
+  , abilityType = LoyaltyAb
   }
 
 hasAtLeastLoyalty :: Int -> Contextual (View Bool)

Magic/src/Magic/Abilities.hs

@@ -4,7 +4,7 @@
 module Magic.Abilities (
     -- * Ability types
     Contextual,
-    ActivatedAbility(..), TapCost(..), AbilityType(..),
+    ActivatedAbility(..), Activation(..), TapCost(..), AbilityType(..),
     StackItem, ManaPool,
     StaticKeywordAbility(..),
     ReplacementEffect, TriggeredAbilities,
@@ -66,18 +66,16 @@ sorcerySpeed rSelf rp = instantSpeed rSelf rp &&* myMainPhase &&* isStackEmpty
 
 
 -- | Play a nonland, non-aura permanent.
-playPermanent :: ManaPool -> ActivatedAbility
+playPermanent :: ManaPool -> Activation
 playPermanent mc =
-  ActivatedAbility
+  Activation
     { available     = \rSelf rActivator -> do
         self <- asks (objectBase rSelf)
         if Flash `elem` get staticKeywordAbilities self
           then instantSpeed rSelf rActivator
           else sorcerySpeed rSelf rActivator
     , manaCost      = mc
-    , tapCost       = NoTapCost
     , effect        = playPermanentEffect
-    , abilityType   = ActivatedAb
     }
   where
     playPermanentEffect :: Contextual (Magic ())
@@ -86,18 +84,16 @@ playPermanent mc =
 
     resolvePermanent _source = return ()
 
-playAura :: ManaPool -> ActivatedAbility
+playAura :: ManaPool -> Activation
 playAura mc =
-  ActivatedAbility
+  Activation
     { available     = \rSelf rActivator -> do
         self <- asks (objectBase rSelf)
         if Flash `elem` get staticKeywordAbilities self
           then instantSpeed rSelf rActivator
           else sorcerySpeed rSelf rActivator
     , manaCost      = mc
-    , tapCost       = NoTapCost
     , effect        = playAuraEffect
-    , abilityType   = ActivatedAb
     }
   where
     playAuraEffect :: Contextual (Magic ())

Magic/src/Magic/Engine.hs

@@ -239,7 +239,7 @@ executeStep (CombatPhase CombatDamageStep) = do
         Nothing -> return []
         Just (PlayerRef p) -> return [Will (DamagePlayer attackingObject p power True True)]
         Just (ObjectRef (Some Battlefield, i)) -> return [Will (DamageObject attackingObject (Battlefield, i) power True True)]
-  executeEffects TurnBasedActions (concat effectses)
+  _ <- executeEffects TurnBasedActions (concat effectses)
   offerPriority
   -- TODO [510.5]  possibly introduce extra combat damage step for first/double strike
   return ()
@@ -417,8 +417,9 @@ collectAvailableActivatedAbilities predicate p = do
   execWriterT $ do
     for objects $ \(r,o) -> do
       for (zip [0..] (get activatedAbilities o)) $ \(i, ability) -> do
-        ok <- lift (shouldOfferAbility ability r p)
-        when (predicate ability && ok) (tell [(r, i)])
+        ok <- lift (shouldOfferActivation (abilityActivation ability) r p)
+        payCostsOk <- lift (canPayTapCost (tapCost ability) r p)
+        when (predicate ability && ok && payCostsOk) (tell [(r, i)])
 
 collectPlayableCards :: PlayerRef -> Engine [SomeObjectRef]
 collectPlayableCards p = do
@@ -427,31 +428,31 @@ collectPlayableCards p = do
     forM_ objects $ \(r,o) -> do
       case get play o of
         Just playAbility -> do
-          ok <- lift (shouldOfferAbility playAbility r p)
+          ok <- lift (shouldOfferActivation playAbility r p)
           when ok (tell [r])
         Nothing -> return ()
 
-shouldOfferAbility :: ActivatedAbility -> Contextual (Engine Bool)
-shouldOfferAbility ability rSource rActivator = do
-  abilityOk <- view (available ability rSource rActivator)
-  payCostsOk <- canPayTapCost (tapCost ability) rSource rActivator
-  return (abilityOk && payCostsOk)
+shouldOfferActivation :: Activation -> Contextual (Engine Bool)
+shouldOfferActivation activation rSource rActivator =
+  view (available activation rSource rActivator)
 
-activateAbility :: EventSource -> ActivatedAbility -> Contextual (Engine ())
-activateAbility source ability rSource rActivator  = do
+activate :: EventSource -> Activation -> Contextual (Engine ())
+activate source activation rSource rActivator  = do
   --offerManaAbilitiesToPay source rActivator (manaCost ability)
-  payTapCost source (tapCost ability) rSource rActivator
-  executeMagic source (effect ability rSource rActivator)
+  executeMagic source (effect activation rSource rActivator)
 
 executePriorityAction :: PlayerRef -> PriorityAction -> Engine ()
 executePriorityAction p a = do
   case a of
     PlayCard r -> do
       Just ability <- gets (objectBase r .^ play)
-      activateAbility (PriorityActionExecution a) ability r p
+      activate (PriorityActionExecution a) ability r p
     ActivateAbility (r, i) -> do
       abilities <- gets (objectBase r .^ activatedAbilities)
-      activateAbility (PriorityActionExecution a) (abilities !! i) r p
+      let ab = abilities !! i
+      let eventSource = PriorityActionExecution a
+      payTapCost eventSource (tapCost ab) r p
+      activate eventSource (abilityActivation ab) r p
 
 offerManaAbilitiesToPay :: EventSource -> PlayerRef -> ManaPool -> Engine ()
 offerManaAbilitiesToPay _ _ []   = return ()
@@ -472,7 +473,7 @@ offerManaAbilitiesToPay source p cost = do
         else offerManaAbilitiesToPay source p (delete Nothing cost)
     ActivateManaAbility (r, i) -> do
       abilities <- gets (objectBase r .^ activatedAbilities)
-      activateAbility source (abilities !! i) r p
+      activate source (abilityActivation (abilities !! i)) r p
       offerManaAbilitiesToPay source p cost
 
 canPayTapCost :: TapCost -> Contextual (Engine Bool)

Magic/src/Magic/Types.hs

@@ -33,7 +33,7 @@ module Magic.Types (
     Object(..),
       name, colors, types, owner, controller, timestamp, counters,
       pt, loyalty,
-      play, staticKeywordAbilities, layeredEffects, activatedAbilities, triggeredAbilities, replacementEffects,
+      play, alternativePlays, staticKeywordAbilities, layeredEffects, activatedAbilities, triggeredAbilities, replacementEffects,
       temporaryEffects,
     ObjectOfType(..),
       cardObject,
@@ -51,7 +51,7 @@ module Magic.Types (
 
     -- * Abilities
     Contextual,
-    ActivatedAbility(..), TapCost(..), AbilityType(..),
+    ActivatedAbility(..), Activation(..), TapCost(..), AbilityType(..),
     StackItem, ManaPool,
     StaticKeywordAbility(..),
     ReplacementEffect, TriggeredAbilities,
@@ -236,7 +236,8 @@ data Object = Object
 
   --, _indestructible    :: Bool
 
-  , _play                   :: Maybe ActivatedAbility
+  , _play                   :: Maybe Activation
+  , _alternativePlays       :: [Activation]
   , _staticKeywordAbilities :: Bag StaticKeywordAbility
   , _layeredEffects         :: [LayeredEffect]
   , _activatedAbilities     :: [ActivatedAbility]
@@ -408,11 +409,16 @@ data PlaneswalkerSubtype = Chandra | Elspeth | Garruk | Gideon | Jace
 type Contextual a = SomeObjectRef -> PlayerRef -> a
 
 data ActivatedAbility = ActivatedAbility
-  { available       :: Contextual (View Bool)  -- check for cost is implied
+  { abilityActivation :: Activation
+  , abilityType       :: AbilityType
+  , tapCost           :: TapCost
+  }
+
+data Activation = Activation
+  { available       :: Contextual (View Bool)
+      -- check timing, zone, controller
   , manaCost        :: ManaPool
-  , tapCost         :: TapCost
   , effect          :: Contextual (Magic ())
-  , abilityType     :: AbilityType
   }
 
 data TapCost = NoTapCost | TapCost  -- add later: UntapCost

Magic/src/Magic/Utils.hs

@@ -39,6 +39,7 @@ emptyObject t rOwner = Object
   , _loyalty = Nothing
 
   , _play = Nothing
+  , _alternativePlays = []
   , _staticKeywordAbilities = []
   , _layeredEffects = []
   , _activatedAbilities = []