M13.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DoAndIfThenElse #-}

module Magic.M13 where

import Magic
import Magic.BasicLands (tapToAddMana)
import qualified Magic.IdList as IdList

import Control.Applicative
import Control.Arrow (first)
import Control.Category ((.))
import Control.Monad (void, when)
import Data.Boolean (notB, true, (&&*), (||*))
import qualified Data.Foldable as Foldable
import Data.Label (get)
import Data.Label.Monadic ((=:), asks)
import Data.Maybe (isJust)
import Data.Monoid ((<>), mconcat)
import qualified Data.MultiSet as MultiSet
import qualified Data.Set as Set
import Data.Text (Text, pack)
import qualified Data.Text as Text
import Prelude hiding ((.))
import Data.Traversable (traverse)


-- COMMON ABILITIES


exalted :: TriggeredAbilities
exalted events (Some Battlefield, _) p = return [ mkTrigger p (boostPT r)
    | DidDeclareAttackers p' [Attack r _] <- events, p == p' ]
  where
    boostPT :: ObjectRef TyPermanent -> Magic ()
    boostPT (Battlefield, i) = do
      t <- tick
      will $ InstallLayeredEffect (Some Battlefield, i) $
        TemporaryLayeredEffect
          { temporaryTimestamp = t
          , temporaryDuration  = UntilEndOfTurn
          , temporaryEffect    = affectingSelf [ModifyPT (\_ -> return (1, 1))]
          }
exalted _ _ _ = return []



-- WHITE CARDS


ajani'sSunstriker :: Card
ajani'sSunstriker = mkCard $ do
  name  =: Just "Ajani's Sunstriker"
  types =: creatureTypes [Cat, Cleric]
  pt    =: Just (2, 2)
  play  =: Just playObject { manaCost = Just (white 2) }
  staticKeywordAbilities =+ [Lifelink]

angel'sMercy :: Card
angel'sMercy = mkCard $ do
  name =: Just "Angel's Mercy"
  types =: instantType
  play =: Just playObject
    { manaCost = Just (generic 2 <> white 2)
    , effect   = stackSelf $ \_ you -> will (GainLife you 7)
    }

angelicBenediction :: Card
angelicBenediction = mkCard $ do
    name =: Just "Angelic Benediction"
    types =: enchantmentType
    play =: Just playObject
      { manaCost = Just (generic 3 <> white 1) }
    triggeredAbilities =: exalted <> tapTrigger
  where
    tapTrigger :: TriggeredAbilities
    tapTrigger events (Some Battlefield, _) p =
      mconcat [
          do
            p' <- asks (controller . objectPart . object rAttacker)
            if p == p'
              then return [mkTapTriggerObject p]
              else return []
        | DidDeclareAttackers _ [Attack rAttacker _] <- events ]
    tapTrigger _ _ _ = return []

    mkTapTriggerObject :: PlayerRef -> Magic ()
    mkTapTriggerObject p = do
        ts <- askTarget p targetCreature
        mkTargetTrigger p ts $ \t -> do
          shouldTap <- askYesNo p "Do you want to tap target creature?"
          when shouldTap $ will (TapPermanent t)

attendedKnight :: Card
attendedKnight = mkCard $ do
    name      =: Just "Attended Knight"
    types     =: creatureTypes [Human, Knight]
    pt        =: Just (2, 2)
    play      =: Just playObject
      { manaCost = Just (generic 2 <> white 1) }
    staticKeywordAbilities =+ [FirstStrike]
    triggeredAbilities     =: trigger
  where
    trigger :: TriggeredAbilities
    trigger = onSelfETB $ \_ p -> mkTrigger p $ do
      t <- tick
      void $ executeEffect $ mkSoldierEffect t p

mkSoldierEffect :: Timestamp -> PlayerRef -> OneShotEffect
mkSoldierEffect t p = WillMoveObject Nothing Battlefield $
    Permanent o Untapped 0 False Nothing Nothing
  where
    o = (emptyObject t p)
        { _name      = Just "Soldier"
        , _colors    = Set.singleton White
        , _types     = creatureTypes [Soldier]
        , _pt        = Just (1, 1)
        }

avenSquire :: Card
avenSquire = mkCard $ do
  name  =: Just "Aven Squire"
  types =: creatureTypes [Bird, Soldier]
  pt    =: Just (1, 1)
  play  =: Just playObject { manaCost = Just (generic 1 <> white 1) }
  staticKeywordAbilities =+ [Flying]
  triggeredAbilities     =: exalted

battleflightEagle :: Card
battleflightEagle = mkCard $ do
    name      =: Just "Battleflight Eagle"
    types     =: creatureTypes [Bird]
    pt        =: Just (2, 2)
    play      =: Just playObject
      { manaCost = Just (generic 4 <> white 1) }
    staticKeywordAbilities =+ [Flying]
    triggeredAbilities     =: onSelfETB createBoostTrigger
  where
    createBoostTrigger :: Contextual (Magic ())
    createBoostTrigger _ p = do
      ts <- askTarget p targetCreature
      mkTargetTrigger p ts $ \(Battlefield, i) -> do
        t <- tick
        will $
          InstallLayeredEffect (Some Battlefield, i) TemporaryLayeredEffect
            { temporaryTimestamp = t
            , temporaryDuration  = UntilEndOfTurn
            , temporaryEffect    = affectingSelf
                [ModifyPT (\_ -> return (2, 2)), AddStaticKeywordAbility Flying]
            }

captainOfTheWatch :: Card
captainOfTheWatch = mkCard $ do
    name  =: Just "Captain of the Watch"
    types =: creatureTypes [Human, Soldier]
    pt    =: Just (3, 3)
    play  =: Just playObject { manaCost =
      Just (generic 4 <> white 2) }
    staticKeywordAbilities =+ [Vigilance]
    layeredEffects         =: [boostSoldiers]
    triggeredAbilities     =: trigger
  where
    boostSoldiers = LayeredObjectEffect
      { affectedObjects = affectRestOfBattlefield $ \you ->
          isControlledBy you &&* hasTypes (creatureTypes [Soldier])
      , objectModifications = [ AddStaticKeywordAbility Vigilance
                        , ModifyPT (\_ -> return (1, 1))]
      }

    trigger = onSelfETB $ \_ p -> mkTrigger p $ do
      t <- tick
      void $ executeEffects $ replicate 3 $ mkSoldierEffect t p

captain'sCall :: Card
captain'sCall = mkCard $ do
  name  =: Just "Captain's Call"
  types =: sorceryType
  play  =: Just playObject
    { manaCost = Just (generic 3 <> white 1)
    , effect = stackSelf $ \_ you -> do
        t <- tick
        void $ executeEffects $ replicate 3 $ mkSoldierEffect t you
    }

crusaderOfOdric :: Card
crusaderOfOdric = mkCard $ do
    name =: Just "Crusader of Odric"
    types =: creatureTypes [Human, Soldier]
    play =: Just playObject {
      manaCost = Just (generic 2 <> white 1)
    }
    layeredEffects =: [definePT]
  where
    definePT :: LayeredEffect
    definePT = LayeredObjectEffect
      { affectedObjects = affectSelf
      , objectModifications = [DefinePT ( \rSelf ->
        do
          cards <- (map (get objectPart) . IdList.elems) <$> view (asks (battlefield))
          you <- view (asks (controller . objectBase rSelf))
          let c = length $ filter (isControlledBy you &&* hasTypes creatureType) cards
          return (c, c))]
      }

divineFavor :: Card
divineFavor = mkCard $ do
    name =: Just "Divine Favor"
    types =: auraType
    staticKeywordAbilities =+ [EnchantPermanent creatureType]
    triggeredAbilities =: gainLifeTrigger
    layeredEffects =: [boostEnchanted]
    play =: Just playObject { manaCost = Just (generic 1 <> white 1) }
  where
    gainLifeTrigger = onSelfETB $ \_ you ->
      mkTrigger you (will (GainLife you 3))
    boostEnchanted = LayeredObjectEffect
      { affectedObjects = affectAttached
      , objectModifications = [ModifyPT (\_ -> return (1, 3))]
      }

erase :: Card
erase = mkCard $ do
    name =: Just "Erase"
    types =: instantType
    play =: Just playObject
      { manaCost = Just (white 1)
      , effect = eraseEffect
      }
  where
    eraseEffect :: Contextual (Magic ())
    eraseEffect rSelf you = do
      ts <- askTarget you targetEnchantment
      stackTargetSelf rSelf you ts $ \t _ _ -> do
        ench <- view (asks (objectPart . object t))
        void . executeEffect $ willMoveToExile t ench

guardianLions :: Card
guardianLions = mkCard $ do
    name =: Just "Guardian Lions"
    types =: creatureTypes [Cat]
    pt =: Just (1, 6)
    play =: Just playObject {
      manaCost = Just (generic 4 <> white 1)
    }
    staticKeywordAbilities =+ [Vigilance]

guardiansOfAkrasa :: Card
guardiansOfAkrasa = mkCard $ do
    name =: Just "Guardians of Akrasa"
    types =: creatureTypes [Human, Soldier]
    pt =: Just (0, 4)
    play =: Just playObject {
      manaCost = Just (generic 2 <> white 1)
    }
    staticKeywordAbilities =+ [Defender]
    triggeredAbilities =: exalted

healerOfThePride :: Card
healerOfThePride = mkCard $ do
    name =: Just "Healer of the Pride"
    types =: creatureTypes [Cat, Cleric]
    pt =: Just (2, 3)
    play =: Just playObject {
      manaCost = Just (generic 3 <> white 1)
    }
    triggeredAbilities =: gainLifeTrigger
  where
    gainLifeTrigger :: TriggeredAbilities
    gainLifeTrigger events (Some Battlefield, _) you =
      mconcat [
          do
            p <- asks (controller . objectPart . object (Battlefield, i))
            isCreatureCard <- hasTypes creatureType <$> asks (objectPart . object (Battlefield, i))
            if you == p && isCreatureCard
              then return [mkTrigger you (will (GainLife you 2))]
              else return []
        | DidMoveObject _ (Some Battlefield, i) <- events ]
    gainLifeTrigger _ _ _ = return []

pacifism :: Card
pacifism = mkCard $ do
    name =: Just "Pacifism"
    types =: auraType
    staticKeywordAbilities =+ [EnchantPermanent creatureType]
    play =: Just playObject { manaCost = Just (generic 1 <> white 1) }
    layeredEffects =: [eff]
  where
    eff = LayeredObjectEffect
      { affectedObjects = affectAttached
      , objectModifications = [ RestrictAllowAttacks selfCantAttack
                        , RestrictAllowBlocks  selfCantBlock ]
      }

planarCleansing :: Card
planarCleansing = mkCard $ do
     name =: Just "Planar Cleansing"
     types =: sorceryType
     play =: Just playObject { manaCost = Just (generic 3 <> white 3),
         effect = stackSelf destroyAllPermanents }
   where
     destroyAllPermanents :: ObjectRef 'TyStackItem -> PlayerRef -> Magic ()
     destroyAllPermanents _ _ = do
        objects <- IdList.toList <$> view (asks (battlefield))
        let objectRefs = map (\pair -> (Battlefield, fst pair)) $ filter (not . hasTypes landType . get objectPart . snd) objects
        let destructionEffects = map (\objectRef -> DestroyPermanent objectRef true) objectRefs
        void $ executeEffects $ map Will destructionEffects

pillarfieldOx :: Card
pillarfieldOx = mkCard $ do
    name =: Just "Pillarfield Ox"
    types =: creatureTypes [Ox]
    pt =: Just (2, 4)
    play =: Just playObject {
        manaCost = Just (generic 3 <> white 1)
    }

serraAngel :: Card
serraAngel = mkCard $ do
    name =: Just "Serra Angel"
    types =: creatureTypes [Angel]
    pt =: Just (4, 4)
    play =: Just playObject {
      manaCost = Just (generic 3 <> white 2)
    }
    staticKeywordAbilities =+ [Flying, Vigilance]

silvercoatLion :: Card
silvercoatLion = mkCard $ do
    name =: Just "Silvercoat Lion"
    types =: creatureTypes [Cat]
    pt =: Just (2, 2)
    play =: Just playObject {
      manaCost = Just (generic 1 <> white 1)
    }

showOfValor :: Card
showOfValor = mkCard $ do
    name =: Just "Show of Valor"
    types =: instantType
    play =: Just playObject
      { manaCost = Just (generic 1 <> white 1)
      , effect = showOfValorEffect
      }
  where
    showOfValorEffect rSelf you = do
      ts <- askTarget you targetCreature
      stackTargetSelf rSelf you ts $ \(zr, i) _stackSelf _stackYou -> do
        t <- tick
        will $
          InstallLayeredEffect (Some zr, i) TemporaryLayeredEffect
            { temporaryTimestamp = t
            , temporaryDuration  = UntilEndOfTurn
            , temporaryEffect    = affectingSelf
                [ModifyPT (\_ -> return (2, 4))]
            }

warFalcon :: Card
warFalcon = mkCard $ do
    name =: Just "War Falcon"
    types =: creatureTypes[Bird]
    pt =: Just (2, 1)
    staticKeywordAbilities =+ [Flying]
    play =: Just playObject { manaCost = Just (white 1) }
    allowAttacks =: controlsKnightOrSoldier
  where
    controlsKnightOrSoldier :: [Attack] -> Contextual (View Bool)
    controlsKnightOrSoldier ats (Some Battlefield, i) p = do
        cards <- (map (get objectPart) . IdList.elems) <$> view (asks (battlefield))
        let ok = isControlledBy p &&* (hasTypes (creatureTypes [Knight]) ||* hasTypes (creatureTypes [Soldier]))
        return $ (Battlefield, i) `notElem` map attacker ats || any ok cards
    controlsKnightOrSoldier _ _ _ = true

warPriestOfThune :: Card
warPriestOfThune = mkCard $ do
    name =: Just "War Priest of Thune"
    types =: creatureTypes [Human, Cleric]
    pt =: Just (2, 2)
    play =: Just playObject { manaCost = Just (generic 1 <> white 1) }
    triggeredAbilities =: onSelfETB warPriestOfThuneTrigger
  where
    warPriestOfThuneTrigger _rSelf you = do
      ench <- askTarget you targetEnchantment
      mkTargetTrigger you ench $ \ref -> do
        shouldDestroy <- askYesNo you "Destroy target enchantment?"
        when shouldDestroy $ will (DestroyPermanent ref True)


-- BLUE

divination :: Card
divination = mkCard $ do
    name =: Just "Divination"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just (generic 2 <> blue 1)
      , effect = stackSelf $ \_ stackYou ->
          void $ executeEffects $ replicate 2 (Will (DrawCard stackYou))
      }

downpour :: Card
downpour = mkCard $ do
    name =: Just "Downpour"
    types =: instantType
    play =: Just playObject
      { manaCost = Just (generic 1 <> blue 1)
      , effect = downpourEffect
      }
  where
    downpourEffect rSelf rYou = do
      ts <- askTargetsUpTo 3 rYou targetCreature
      stackTargetSelf rSelf rYou ts $ \t _stackSelf _stackYou ->
        void. executeEffects $ map (Will . TapPermanent) t

faerieInvaders :: Card
faerieInvaders = mkCard $ do
    name =: Just "Faerie Invaders"
    types =: creatureTypes [Faerie, Rogue]
    staticKeywordAbilities =+ [Flash]
    play =: Just playObject
      { manaCost = Just (generic 4 <> blue 1) }

mindSculpt :: Card
mindSculpt = mkCard $ do
    name =: Just "Mind Sculpt"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just (generic 1 <> blue 1)
      , effect = mindSculptEffect
      }
  where
    mindSculptEffect :: Contextual (Magic ())
    mindSculptEffect rSelf you = do
      ps <- askTarget you (targetOpponent you)
      stackTargetSelf rSelf you ps $ \p _ _ -> do
        cards <- IdList.toList <$> view (asks (library . player p))
        moveCards (take 7 cards) (Library p) (Graveyard p)

tricksOfTheTrade :: Card
tricksOfTheTrade = mkCard $ do
    name =: Just "Tricks of the Trade"
    types =: auraType
    staticKeywordAbilities =+ [EnchantPermanent creatureType]
    layeredEffects =: [boostEnchanted]
    play =: Just playObject
      { manaCost = Just (generic 3 <> blue 1) }
  where
    boostEnchanted = LayeredObjectEffect
      { affectedObjects = affectAttached
      , objectModifications = [ModifyPT (\_ -> return (2, 0)), RestrictAllowBlocks selfCantBeBlocked]
      }


-- BLACK CARDS

bloodHunterBat :: Card
bloodHunterBat = mkCard $ do
    name =: Just "Bloodhunter Bat"
    types =: creatureTypes [Bat]
    pt =: Just (2, 2)
    play =: Just playObject { manaCost = Just (generic 3 <> black 1) }
    triggeredAbilities =: onSelfETB bloodHunterBatTrigger
  where
    bloodHunterBatTrigger :: Contextual (Magic ())
    bloodHunterBatTrigger _rSelf you = do
      opps <- askTarget you (targetOpponent you)
      mkTargetTrigger you opps $ \opp ->
        void $ executeEffects [Will $ LoseLife opp 2, Will $ GainLife you 2]

cripplingBlight :: Card
cripplingBlight = mkCard $ do
  name =: Just "Crippling Blight"
  types =: auraType
  staticKeywordAbilities =+ [EnchantPermanent creatureType]
  layeredEffects =: [boostEnchanted]
  play =: Just playObject
    { manaCost = Just (black 1) }
  where
    boostEnchanted = LayeredObjectEffect
      { affectedObjects = affectAttached
      , objectModifications = [ModifyPT (\_ -> return (-1, -1)), RestrictAllowBlocks selfCantBlock]
      }

darkFavor :: Card
darkFavor = mkCard $ do
    name =: Just "Dark Favor"
    types =: auraType
    play =: Just playObject
      { manaCost = Just (generic 1 <> black 1) }
    triggeredAbilities =: loseLifeTrigger
    layeredEffects =: [darkFavorEffect]
  where
    loseLifeTrigger = onSelfETB $ \_ you ->
      mkTrigger you (will (LoseLife you 1))
    darkFavorEffect = LayeredObjectEffect
      { affectedObjects = affectAttached
      , objectModifications = [ModifyPT (\_ -> return (3, 1))]
      }

disentomb :: Card
disentomb = mkCard $ do
  name =: Just "Disentomb"
  types =: sorceryType
  play =: Just playObject
    { manaCost = Just (black 1)
    , effect = \rSelf you -> do
        ts <- askTarget you (isCreatureCard <?> targetInZone (Graveyard you))
        stackTargetSelf rSelf you ts $ \t@(z, i) _ stackYou -> do
          card <- view (asks (object t))
          void $ executeEffect $
            WillMoveObject (Just (Some z, i)) (Hand stackYou) card
    }
  where
    isCreatureCard :: ObjectRef TyCard -> View Bool
    isCreatureCard r = hasTypes creatureType <$> asks (objectPart . object r)

essenceDrain :: Card
essenceDrain = mkCard $ do
    name =: Just "Essence Drain"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just (generic 4 <> black 1)
      , effect = essenceDrainEffect
      }
  where
    essenceDrainEffect rSelf you = do
      ts <- askTarget you targetCreatureOrPlayer
      stackTargetSelf rSelf you ts $ \t rStackSelf stackYou -> do
        self <- view (asks (objectPart . object rStackSelf))
        let damageEffect = case t of
              Left r  -> DamageObject self r 3 False True
              Right p -> DamagePlayer self p 3 False True
        void $ executeEffects [Will damageEffect, Will $ GainLife stackYou 3]

liliana'sShade :: Card
liliana'sShade = mkCard $ do
    name =: Just "Liliana's Shade"
    types =: creatureTypes [Shade]
    pt =: Just (1, 1)
    play =: Just playObject { manaCost = Just (generic 2 <> black 2) }
    triggeredAbilities =: liliana'sShadeTrigger
    activatedAbilities =: [liliana'sShadeAbility]
  where
    liliana'sShadeTrigger = onSelfETB $ \_ you -> mkTrigger you $ do
      doSearch <- askYesNo you "Do you want to search the library for a Swamp card?"
      when doSearch $ do
        swamp <- searchCard you (Library you) (hasTypes (landTypes [Swamp]))
        case swamp of
          Just s -> do
            let ref = (Library you, s)
            refObj <- view (asks (object ref))
            void $ executeEffects
              [ Will $ RevealCards you [ref]
              , WillMoveObject (Just (toSomeObjectRef ref)) (Hand you) refObj
              ]
            will $ ShuffleLibrary you
          Nothing -> return ()
    plus1plus1 rSelf you = do
      t <- tick
      mkAbility you $
        will $ InstallLayeredEffect rSelf TemporaryLayeredEffect
          { temporaryTimestamp = t
          , temporaryDuration  = UntilEndOfTurn
          , temporaryEffect    = affectingSelf [ModifyPT (\_ -> return (1, 1))]
          }
    liliana'sShadeAbility = ActivatedAbility
      { abilityType = ActivatedAb
      , tapCost = NoTapCost
      , abilityActivation = defaultActivation
        { effect = plus1plus1
          , manaCost = Just (black 1)
        }
      }

mindRot :: Card
mindRot = mkCard $ do
    name =: Just "Mind Rot"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just (generic 2 <> black 1)
      , effect = mindRotEffect
      }
  where
    mindRotEffect rSelf you = do
      tpl <- askTarget you targetPlayer
      stackTargetSelf rSelf you tpl $ \tp _rStackSelf _stackYou -> discardCards tp 2

ravenousRats :: Card
ravenousRats = mkCard $ do
    name =: Just "Ravenous Rats"
    types =: creatureTypes [Rat]
    pt =: Just (1, 1)
    play =: Just playObject { manaCost = Just (generic 1 <> black 1) }
    triggeredAbilities =: onSelfETB ravenousRatsTrigger
  where
    ravenousRatsTrigger _rSelf you = do
      opp <- askTarget you (targetOpponent you)
      mkTargetTrigger you opp $ \o -> discardCards o 1

tormentedSoul :: Card
tormentedSoul = mkCard $ do
    name =: Just "Tormented Soul"
    types =: creatureTypes [Spirit]
    play =: Just playObject { manaCost = Just (black 1) }
    layeredEffects =: [affectingSelf
      [RestrictAllowBlocks (selfCantBlock &&* selfCantBeBlocked)]]

vampireNighthawk :: Card
vampireNighthawk = mkCard $ do
  name  =: Just "Vampire Nighthawk"
  types =: creatureTypes [Vampire, Shaman]
  pt    =: Just (2, 3)
  play  =: Just playObject { manaCost = Just (generic 1 <> black 2) }
  staticKeywordAbilities =+ [Flying, Deathtouch, Lifelink]


-- RED CARDS


fervor :: Card
fervor = mkCard $ do
    name              =: Just "Fervor"
    types             =: enchantmentType
    play              =: Just playObject
      { manaCost = Just (generic 2 <> red 1) }
    layeredEffects    =: [grantHaste]
  where
    grantHaste = LayeredObjectEffect
      { affectedObjects = affectBattlefield $ \you ->
          isControlledBy you &&* hasTypes creatureType
      , objectModifications = [AddStaticKeywordAbility Haste]
      }

fireElemental :: Card
fireElemental = mkCard $ do
  name  =: Just "Fire Elemental"
  types =: creatureTypes [Elemental]
  pt    =: Just (5, 4)
  play  =: Just playObject
    { manaCost = Just (generic 3 <> red 2) }

firewingPhoenix :: Card
firewingPhoenix = mkCard $ do
    name =: Just "Firewing Phoenix"
    types =: creatureTypes [Phoenix]
    pt    =: Just (4, 2)
    staticKeywordAbilities =+ [Flying]
    play =: Just playObject
      { manaCost = Just (generic 3 <> red 1) }
    activatedAbilities =: [returnFromGraveyard]
  where
    returnFromGraveyard = ActivatedAbility
      { abilityActivation = defaultActivation
        { available = availableFromGraveyard
        , manaCost  = Just (generic 1 <> red 3)
        , effect    = \(Some (Graveyard zr), i) you -> mkAbility you $ do
            card <- view (asks (object (Graveyard zr, i)))
            void $ executeEffect $
              WillMoveObject (Just (Some (Graveyard you), i)) (Hand you) card
        }
      , tapCost     = NoTapCost
      , abilityType = ActivatedAb
      }

furnaceWhelp :: Card
furnaceWhelp = mkCard $ do
  name =: Just "Furnace Whelp"
  types =: creatureTypes [Dragon]
  pt =: Just (2, 2)
  play =: Just playObject {
    manaCost = Just (generic 2 <> red 2)
    }
  activatedAbilities =: [plusOneAbility]
  where
    plusOneAbility = ActivatedAbility
      { abilityType = ActivatedAb
      , tapCost = NoTapCost
      , abilityActivation = defaultActivation
        { effect = \rSelf you -> mkAbility you $ do
            t <- tick
            modifyPTUntilEOT (1, 0) rSelf t
        , manaCost = Just (red 1)
        }
      }

flamesOfTheFirebrand :: Card
flamesOfTheFirebrand = mkCard $ do
  name  =: Just "Flames of the Firebrand"
  types =: sorceryType
  play  =: Just playObject
    { manaCost = Just (generic 2 <> red 1)
    , effect = \rSelf you -> do
        ts <- askTargetsFromUpTo 1 3 you targetCreatureOrPlayer
        let (trs, _) = evaluateTargetList ts
        damages <- case length trs of
          1 -> return [3]
          3 -> return [1,1,1]
          2 -> do
            firstTwo <- askDamage you
              "Choose the target to deal 2 damage to"
              (pack $ show $ head trs)
              (pack $ show $ head $ tail trs)
            return $ if firstTwo then [2,1] else [1,2]
        stackTargetSelf rSelf you ts $ \rs stackSelf _ -> do
          self <- view (asks (objectPart . object stackSelf))
          void . executeEffects $ zipWith (damageEffect self) damages rs
    }
  where
    damageEffect self dmg t' = case t' of
        Left r  -> Will $ DamageObject self r dmg False True
        Right p -> Will $ DamagePlayer self p dmg False True
    askDamage :: PlayerRef -> Text -> Text -> Text -> Magic Bool
    askDamage p txt c1 c2 = askQuestion p (AskChoice (Just txt) choices)
      where
        choices = [(ChoiceText c1, True), (ChoiceText c2, False)]

moggFlunkies :: Card
moggFlunkies = mkCard $ do
    name =: Just "Mogg Flunkies"
    types =: creatureTypes [Goblin]
    pt =: Just (3, 3)
    play =: Just playObject { manaCost = Just (generic 1 <> red 1) }
    layeredEffects =: [affectingSelf
      [ RestrictAllowAttacks selfCantAttackAlone
      , RestrictAllowBlocks  selfCantBlockAlone  ] ]

searingSpear :: Card
searingSpear = mkCard $ do
    name  =: Just "Searing Spear"
    types =: instantType
    play  =: Just playObject
      { manaCost = Just (generic 1 <> red 1)
      , effect   = searingSpearEffect
      }
  where
    searingSpearEffect :: Contextual (Magic ())
    searingSpearEffect rSelf you = do
      ts <- askTarget you targetCreatureOrPlayer
      stackTargetSelf rSelf you ts $ \t rStackSelf _stackYou -> do
        self <- view (asks (objectPart . object rStackSelf))
        will $ case t of
          Left r  -> DamageObject self r 3 False True
          Right p -> DamagePlayer self p 3 False True

smelt :: Card
smelt = mkCard $ do
    name  =: Just "Smelt"
    types =: instantType
    play  =: Just playObject
      { manaCost = Just (red 1)
      , effect = destroyTargetPermanent (hasTypes artifactType)
      }

thundermawHellkite :: Card
thundermawHellkite = mkCard $ do
    name           =: Just "Thundermaw Hellkite"
    types          =: creatureTypes [Dragon]
    pt             =: Just (5, 5)
    play           =: Just playObject
      { manaCost = Just (generic 3 <> red 2)
      }
    staticKeywordAbilities =+ [Flying, Haste]
    triggeredAbilities =: onSelfETB thundermawHellkiteTrigger
  where
    thundermawHellkiteTrigger :: Contextual (Magic ())
    thundermawHellkiteTrigger rSelf you = mkTrigger you $ do
      self <- view (asks (objectBase rSelf))
      let isAffected = notB (isControlledBy you) &&* hasStaticKeywordAbility Flying
      objs <- filter (isAffected . get permanentObject . snd) <$> viewZone Battlefield
      let damage r = DamageObject self r 1 False True
      let damageAndTap r = [Will (damage r), Will (TapPermanent r)]
      void . executeEffects $ concatMap damageAndTap (map fst objs)


torchFiend :: Card
torchFiend = mkCard $ do
    name  =: Just "Torch Fiend"
    types =: creatureTypes [Devil]
    pt    =: Just (2, 1)
    play  =: Just playObject
      { manaCost = Just (generic 1 <> red 1)
      }
    activatedAbilities =: [torchFiendAbility]
  where
    torchFiendAbility = ActivatedAbility
      { abilityActivation = torchFiendActivation
      , abilityType = ActivatedAb
      , tapCost = NoTapCost
      }
    torchFiendActivation = defaultActivation
      { manaCost = Just (red 1)
      , effect = torchFiendEffect
      }
    torchFiendEffect :: Contextual (Magic ())
    torchFiendEffect rSelf@(Some Battlefield, i) you = do
      ts <- askTarget you $ checkPermanent (hasTypes artifactType) <?> targetPermanent
      will (Sacrifice (Battlefield, i))
      mkTargetAbility you ts $ \t ->
        will $ DestroyPermanent t True


trumpetBlast :: Card
trumpetBlast = mkCard $ do
    name  =: Just "Trumpet Blast"
    types =: instantType
    play  =: Just playObject
      { manaCost = Just (generic 2 <> red 1)
      , effect = stackSelf titanicGrowthEffect
      }
  where
    titanicGrowthEffect _rSelf _you = do
      let isAttacking = isJust . get attacking
      objs <- map fst . filter (isAttacking . snd) <$> viewZone Battlefield
      t <- tick
      void $ traverse (\(r, i) -> modifyPTUntilEOT (2, 0) (Some r, i) t) objs


-- GREEN CARDS

acidicSlime :: Card
acidicSlime = mkCard $ do
    name =: Just "Acidic Slime"
    types =: creatureTypes [Ooze]
    pt =: Just (2, 2)
    play =: Just playObject { manaCost = Just (generic 3 <> green 2) }
    staticKeywordAbilities =+ [Deathtouch]
    triggeredAbilities =: onSelfETB acidicSlimeTrigger
  where
    targetTypes = [artifactType, enchantmentType, landType]
    acidicSlimeTrigger _ p = do
      ts <- askTarget p $ checkPermanent (hasOneOfTypes targetTypes) <?> targetPermanent
      mkTargetTrigger p ts $ \ref -> will $ DestroyPermanent ref True

arborElf :: Card
arborElf = mkCard $ do
    name =: Just "Arbor Elf"
    types =: creatureTypes [Elf, Druid]
    pt =: Just (1, 1)
    play =: Just playObject { manaCost = Just (green 1) }
    activatedAbilities =: [untapTargetForest]
  where
    untapTargetForest = tapAbility $ \_ you -> do
      ts <- askTarget you $ checkPermanent
        (hasTypes (landTypes [Forest])) <?> targetPermanent
      mkTargetAbility you ts $ \rForest ->
        will (UntapPermanent rForest)

bondBeetle :: Card
bondBeetle = mkCard $ do
    name =: Just "Bond Beetle"
    types =: creatureTypes [Insect]
    pt =: Just (0, 1)
    play =: Just playObject { manaCost = Just (green 1) }
    triggeredAbilities =: onSelfETB createAddCounterTrigger
  where
    createAddCounterTrigger :: Contextual (Magic ())
    createAddCounterTrigger _ p = do
      ts <- askTarget p targetCreature
      mkTargetTrigger p ts $ \(Battlefield, i) ->
        will $ AddCounter (Some Battlefield, i) Plus1Plus1

bountifulHarvest :: Card
bountifulHarvest = mkCard $ do
    name =: Just "Bountiful Harvest"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just $ (generic 4 <> green 1)
      , effect = bountifulHarvestEffect
      }
  where
    bountifulHarvestEffect :: Contextual (Magic ())
    bountifulHarvestEffect = stackSelf $ \_stackSelf stackYou -> do
      objs <- IdList.elems <$> view (asks battlefield)
      let objectParts = map (get objectPart) objs
          lands = flip filter objectParts $ \o ->
            get controller o == stackYou && hasTypes landType o
      will $ GainLife stackYou (length lands)

centaurCourser :: Card
centaurCourser = mkCard $ do
  name =: Just "Centaur Courser"
  types =: creatureTypes [Centaur, Warrior]
  pt =: Just (3, 3)
  play =: Just playObject { manaCost = Just (generic 2 <> green 1) }

deadlyRecluse :: Card
deadlyRecluse = mkCard $ do
  name =: Just "Deadly Recluse"
  types =: creatureTypes [Spider]
  pt =: Just (1, 2)
  play =: Just playObject { manaCost = Just (generic 1 <> green 1) }
  staticKeywordAbilities =+ [Reach, Deathtouch]

duskdaleWurm :: Card
duskdaleWurm = mkCard $ do
  name =: Just "Duskdale Wurm"
  types =: creatureTypes [Wurm]
  pt =: Just (7, 7)
  play =: Just playObject { manaCost = Just (generic 5 <> green 2) }
  staticKeywordAbilities =+ [Trample]

elvishArchdruid :: Card
elvishArchdruid = mkCard $ do
    name =: Just "Elvish Archdruid"
    types =: creatureTypes [Elf, Druid]
    pt =: Just (2, 2)
    play =: Just playObject { manaCost = Just (generic 1 <> green 2) }
    activatedAbilities =: [addManaAbility]
    layeredEffects =: [boostYourElves]
  where
    addManaAbility = tapAbility $ \_rSelf you -> do
      cards <- (map (get objectPart) . IdList.elems) <$> view (asks battlefield)
      let yourElves = filter (isControlledBy you &&* hasTypes (creatureTypes [Elf])) cards
      mkTrigger you $ will $ AddToManaPool you $ MultiSet.insertMany (ColorEl Green) (length yourElves) mempty

    boostYourElves = LayeredObjectEffect
      { affectedObjects = affectRestOfBattlefield $ \you ->
          isControlledBy you &&* hasTypes (creatureTypes [Elf])
      , objectModifications = [ModifyPT (\_ -> return (1, 1))]
      }

elvishVisionary :: Card
elvishVisionary = mkCard $ do
    name =: Just "Elvish Visionary"
    types =: creatureTypes [Elf, Shaman]
    pt =: Just (1, 1)
    play =: Just playObject { manaCost = Just (generic 1 <> green 1) }
    triggeredAbilities =: onSelfETB drawCardEffect
  where
    drawCardEffect _ you = mkTrigger you $ will $ DrawCard you

farseek :: Card
farseek = mkCard $ do
    name =: Just "Farseek"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just (generic 1 <> green 1)
      , effect = farseekEffect
      }
  where
    farseekEffect = stackSelf $ \_rStackSelf stackYou -> do
      let validLandTypes = map (landTypes . (:[])) [Plains, Island, Swamp, Mountain]
      maybeId <- searchCard stackYou (Library stackYou) (hasOneOfTypes validLandTypes)
      _ <- case maybeId of
        Just i -> do
          let objectRef = (Some (Library stackYou), i)
          land <- view (asks (objectPart . object (Library stackYou, i)))
          void . executeEffect $
            WillMoveObject (Just objectRef) Battlefield $ Permanent land Tapped 0 False Nothing Nothing
        Nothing -> return ()
      will $ ShuffleLibrary stackYou

fungalSprouting :: Card
fungalSprouting = mkCard $ do
    name =: Just "Fungal Sprouting"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just (generic 3 <> green 1)
      , effect = makeTokenEffect
      }
  where
    makeTokenEffect = stackSelf $ \_rSelf you -> do
      perms <- (map (get objectPart) . IdList.elems) <$> view (asks battlefield)
      t <- tick
      let yours = filter (isControlledBy you &&* hasTypes creatureType) perms
          maxPower = maximum $ 0 : map (maybe 0 fst . get pt) yours
          token = simpleCreatureToken t you [Saproling] [Green] (1,1)
      void $ executeEffects $ replicate maxPower $
        WillMoveObject Nothing Battlefield (Permanent token Untapped 0 False Nothing Nothing)

garrukPrimalHunter :: Card
garrukPrimalHunter = mkCard $ do
    name =: Just "Garruk, Primal Hunter"
    types =: planeswalkerWithType Garruk
    play =: Just playObject { manaCost = Just (generic 2 <> green 3) }
    activatedAbilities =: [plusOne, minusThree, minusSix]
    loyalty =: Just 3
    replacementEffects =: [etbWithLoyaltyCounters]
  where
    plusOne = loyaltyAbility 1 $ \_ you -> do
      mkAbility you $ do
        t <- tick
        let token = simpleCreatureToken t you [Beast] [Green] (3,3)
        void $ executeEffect $ WillMoveObject Nothing Battlefield (Permanent token Untapped 0 False Nothing Nothing)
    minusThree = loyaltyAbility (-3) $ \_ you -> do
      mkAbility you $ do
        objs <- IdList.elems <$> view (asks battlefield)
        let n = foldr max 0 [ power
                            | o <- objs
                            , get (controller . objectPart) o == you
                            , let Just (power, _) = get (pt . objectPart) o ]
        void $ executeEffects (replicate n (Will (DrawCard you)))
    minusSix = loyaltyAbility (-6) $ \_ you -> do
      mkAbility you $ do
        perms <- IdList.elems <$> view (asks battlefield)
        let n = count perms $ \perm ->
                  let o = get objectPart perm
                   in get controller o == you && hasTypes landType o
        t <- tick
        let token = simpleCreatureToken t you [Wurm] [Green] (6,6)
        void $ executeEffects $ replicate n $
          WillMoveObject Nothing Battlefield (Permanent token Untapped 0 False Nothing Nothing)

naturalize :: Card
naturalize = mkCard $ do
    name =: Just "Naturalize"
    types =: instantType
    play =: Just playObject
      { manaCost = Just (generic 1 <> green 1)
      , effect = naturalizeEffect
      }
  where
    naturalizeEffect = destroyTargetPermanent (hasOneOfTypes [artifactType, enchantmentType])

plummet :: Card
plummet = mkCard $ do
    name =: Just "Plummet"
    types =: instantType
    play =: Just playObject
      { manaCost = Just (generic 1 <> green 1)
      , effect = plummetEffect
      }
  where
    plummetEffect = destroyTargetPermanent (hasStaticKeywordAbility Flying)

preyUpon :: Card
preyUpon = mkCard $ do
    name =: Just "Prey Upon"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just (green 1)
      , effect = preyUponEffect
      }
  where
    preyUponEffect rSelf you = do
      yourCreature  <- askTarget you $ checkPermanent (      isControlledBy you) <?> targetCreature
      otherCreature <- askTarget you $ checkPermanent (not . isControlledBy you) <?> targetCreature
      let creatures = (,) <$> yourCreature <*> otherCreature
      stackTargetSelf rSelf you creatures $ \(yours@(yz, yi), other@(oz, oi)) _stackSelf _stackYou -> do
        yourObj <- view (asks (objectBase (Some yz, yi)))
        otherObj <- view (asks (objectBase (Some oz, oi)))
        let Just (yourPower, _) = get pt yourObj
            Just (otherPower, _) = get pt otherObj
        void . executeEffects $
          [ Will $ DamageObject yourObj other yourPower False True
          , Will $ DamageObject otherObj yours otherPower False True
          ]

primalHuntbeast :: Card
primalHuntbeast = mkCard $ do
  name =: Just "Primal Huntbeast"
  types =: creatureTypes [Beast]
  pt =: Just (3, 3)
  play =: Just playObject { manaCost = Just (generic 3 <> green 1) }
  staticKeywordAbilities =+ [Hexproof]

quirionDryad :: Card
quirionDryad = mkCard $ do
    name =: Just "Quirion Dryad"
    types =: creatureTypes [Dryad]
    pt =: Just (1, 1)
    play =: Just playObject { manaCost = Just (generic 1 <> green 1) }
    triggeredAbilities =: dryadTrigger
  where
    dryadTrigger :: TriggeredAbilities
    dryadTrigger events rSelf@(Some Battlefield, _) p = mconcat [
      do
        obj <- asks (objectBase someRef)
        let controlledByYou = p == get controller obj
            nonGreenSpell = Foldable.any (`elem` [White, Blue, Black, Red]) (get colors obj)
            mkAddCounterTrigger = mkTrigger p $ will $ AddCounter rSelf Plus1Plus1
        return [mkAddCounterTrigger | controlledByYou && nonGreenSpell]
      | DidMoveObject (Just _) someRef@(Some Stack, _) <- events]
    dryadTrigger _ _ _ = return []

revive :: Card
revive = mkCard $ do
    name =: Just "Revive"
    types =: sorceryType
    play =: Just playObject
      { manaCost = Just (generic 1 <> green 1)
      , effect = reviveEffect
      }
  where
    reviveEffect rSelf you = do
      ts <- askTarget you (isGreen <?> targetInZone (Graveyard you))
      stackTargetSelf rSelf you ts $ \ref@(zone, i) _stackSelf stackYou -> do
        obj <- view (asks (objectPart . object ref))
        void . executeEffect $ WillMoveObject (Just (Some zone, i)) (Hand stackYou) (CardObject obj)
    isGreen :: ObjectRef TyCard -> View Bool
    isGreen r = hasColor Green <$> asks (objectPart . object r)

roaringPrimadox :: Card
roaringPrimadox = mkCard $ do
    name =: Just "Roaring Primadox"
    types =: creatureTypes [Beast]
    pt =: Just (4, 4)
    play =: Just playObject { manaCost = Just (generic 3 <> green 1) }
    triggeredAbilities =: roaringPrimadoxTrigger
  where
    roaringPrimadoxTrigger :: TriggeredAbilities
    roaringPrimadoxTrigger events (Some Battlefield, _) p = do
      activeP <- view (asks activePlayer)
      return $ if activeP == p
        then [makeReturnCardTrigger p | DidBeginStep (BeginningPhase UpkeepStep) <- events]
        else []
    roaringPrimadoxTrigger _ _ _ = return []

    makeReturnCardTrigger p = do
      ts <- askTarget p (checkPermanent (isControlledBy p) <?> targetCreature)
      mkTargetTrigger p ts $ \ref@(zone, i) -> do
        obj <- view (asks (objectPart . object ref))
        let objOwner = get owner obj
        void $ executeEffect $ WillMoveObject (Just (Some zone, i)) (Hand objOwner) (CardObject obj)

sentinelSpider :: Card
sentinelSpider = mkCard $ do
  name =: Just "Sentinel Spider"
  types =: creatureTypes [Spider]
  play =: Just playObject { manaCost = Just (generic 3 <> green 2) }
  pt =: Just (4, 4)
  staticKeywordAbilities =+ [Vigilance, Reach]

serpent'sGift :: Card
serpent'sGift = mkCard $ do
    name =: Just "Serpent's Gift"
    types =: instantType
    play =: Just playObject
      { manaCost = Just (generic 2 <> green 1)
      , effect = serpent'sGiftEffect
      }
  where
    serpent'sGiftEffect rSelf you = do
      ts <- askTarget you targetCreature
      stackTargetSelf rSelf you ts $ \(zone, i) _rStackSelf _stackYou -> do
        t <- tick
        will $ InstallLayeredEffect (Some zone, i) TemporaryLayeredEffect
          { temporaryTimestamp = t
          , temporaryDuration  = UntilEndOfTurn
          , temporaryEffect    = affectingSelf [AddStaticKeywordAbility Deathtouch]
          }

spikedBaloth :: Card
spikedBaloth = mkCard $ do
  name =: Just "Spiked Baloth"
  types =: creatureTypes [Beast]
  play =: Just playObject { manaCost = Just (generic 3 <> green 1) }
  pt =: Just (4, 2)
  staticKeywordAbilities =+ [Trample]

timberpackWolf :: Card
timberpackWolf = mkCard $ do
  name  =: Just "Timberpack Wolf"
  types =: creatureTypes [Wolf]
  play  =: Just playObject { manaCost = Just (generic 1 <> green 1) }
  pt    =: Just (2, 2)
  layeredEffects =: [updatePT]
  where
    updatePT :: LayeredEffect
    updatePT =  LayeredObjectEffect
      { affectedObjects = affectMyselfOnBattlefield
      , objectModifications = [ModifyPT $ \rSelf ->
          do
            you <- view (asks (controller . objectBase rSelf))
            let isMyWolf = isControlledBy you &&* hasName "Timberpack Wolf"
            wolves <- IdList.filter (isMyWolf . get objectPart) <$> view (asks battlefield)
            let factor = length wolves - 1 -- subtract this current creature
            return (factor, factor)]
      }

    affectMyselfOnBattlefield :: Contextual (View [SomeObjectRef])
    affectMyselfOnBattlefield r@(Some Battlefield, _) you = return [r]
    affectMyselfOnBattlefield _                       _   = return []


titanicGrowth :: Card
titanicGrowth = mkCard $ do
    name =: Just "Titanic Growth"
    types =: instantType
    play =: Just playObject
      { manaCost = Just (generic 3 <> green 1)
      , effect = titanicGrowthEffect
      }
  where
    titanicGrowthEffect rSelf you = do
      ts <- askTarget you targetCreature
      stackTargetSelf rSelf you ts $ \(zone, i) _rStackSelf _stackYou -> do
        t <- tick
        modifyPTUntilEOT (4, 4) (Some zone, i) t

vastwoodGorger :: Card
vastwoodGorger = mkCard $ do
  name =: Just "Vastwood Gorger"
  types =: creatureTypes [Wurm]
  play =: Just playObject { manaCost = Just (generic 5 <> green 1) }
  pt =: Just (5, 6)

yeva'sForcemage :: Card
yeva'sForcemage = mkCard $ do
    name =: Just "Yeva's Forcemage"
    types =: creatureTypes [Elf, Shaman]
    pt =: Just (2, 2)
    play =: Just playObject { manaCost = Just (generic 2 <> green 1) }
    triggeredAbilities =: onSelfETB yeva'sForcemageTrigger
  where
    yeva'sForcemageTrigger _rSelf you = do
      ts <- askTarget you targetCreature
      mkTargetTrigger you ts $ \(zone, i) -> do
        t <- tick
        modifyPTUntilEOT (2, 2) (Some zone, i) t

-- COLORLESS CARDS

chronomaton :: Card
chronomaton = mkCard $ do
    name =: Just "Chronomaton"
    types =: artifactType <> creatureTypes [Golem]
    pt =: Just (1, 1)
    play =: Just playObject { manaCost = Just (generic 1) }
    activatedAbilities =: [addCounter]
  where
    addCounter = tapAbility $ \rSelf you ->
      mkTrigger you $ will (AddCounter rSelf Plus1Plus1)

elixirOfImmortality :: Card
elixirOfImmortality = mkCard $ do
    name =: Just "Elixir of Immortality"
    types =: artifactType
    play =: Just playObject { manaCost = Just (generic 1) }
    activatedAbilities =: [crack]
  where
    crack = tapAbilityWithCost (generic 2) $
      \rSelf you -> mkTrigger you $ do
        will (GainLife you 5)
        rs <- view $ allRefsInSomeZone (Some (Graveyard you))
        void $ shuffleIntoLibrary (rSelf : rs) [you]

tormod'sCrypt :: Card
tormod'sCrypt = mkCard $ do
    name =: Just "Tormod's Crypt"
    types =: artifactType
    play =: Just playObject { manaCost = Just mempty }
    activatedAbilities =: [tapToExile]
  where
    tapToExile = tapAbility $ \(Some Battlefield, i) you -> do
      tp <- askTarget you targetPlayer
      will (Sacrifice (Battlefield, i))
      mkTargetTrigger you tp $ \p -> do
        cards <- IdList.toList <$> view (asks (graveyard . player p))
        moveCards cards (Graveyard p) Exile


moveCards :: [(IdList.Id, ObjectOfType 'TyCard)] -> ZoneRef TyCard -> ZoneRef TyCard -> Magic ()
moveCards cards from to =
  void $ executeEffects
    [ WillMoveObject (Just (Some from, j)) to card
    | (j, card) <- cards
    ]

discardCards :: PlayerRef -> Int -> Magic ()
discardCards p n = do
  pHand <- playerHand p
  let choices = map (first toSomeObjectRef) pHand
  toDiscard <- askChooseCards n p choices
  void $ executeEffects [ WillMoveObject (Just someRef) (Graveyard p) obj  | (someRef, obj) <- toDiscard ]


-- LANDS

dragonskullSummit :: Card
dragonskullSummit = checkLand "Dragonskull Summit" [Black, Red] [Swamp, Mountain]

drownedCatacomb :: Card
drownedCatacomb = checkLand "Drowned Catacomb" [Blue, Black] [Island, Swamp]

glacialFortress :: Card
glacialFortress = checkLand "Glacial Fortress" [White, Blue] [Plains, Island]

rootboundCrag :: Card
rootboundCrag = checkLand "Rootbound Crag" [Red, Green] [Mountain, Forest]

sunpetalGrove :: Card
sunpetalGrove = checkLand "Sunpetal Grove" [White, Green] [Plains, Forest]

checkLand :: Text -> [Color] -> [LandSubtype] -> Card
checkLand n cols tys = mkCard $ do
  name =: Just n
  types =: landType
  play =: Just playObject { manaCost = Just mempty }
  activatedAbilities =: map (tapToAddMana . ColorEl) cols
  replacementEffects =: [ etbTappedUnless (map (\ty -> landTypes [ty]) tys) ]


-- COMMON FUNCTIONALITY

etbTappedUnless :: [ObjectTypes] -> OneShotEffect -> Contextual (Maybe (Magic [OneShotEffect]))
etbTappedUnless tys e@(WillMoveObject (Just r') Battlefield o) r _
  | r' == r = Just $ do
                perms <- (map (get objectPart) . IdList.elems) <$>
                  view (asks battlefield)
                let p = get (owner . objectPart) o
                if null (filter (isControlledBy p &&* gor (map hasTypes tys)) perms)
                then return [WillMoveObject (Just r') Battlefield o { _tapStatus = Tapped } ]
                else return [e]
etbTappedUnless _ _ _ _ = Nothing

modifyPTUntilEOT :: PT -> SomeObjectRef -> Timestamp -> Magic ()
modifyPTUntilEOT pt' ref t = will $
  InstallLayeredEffect ref TemporaryLayeredEffect
    { temporaryTimestamp = t
    , temporaryDuration  = UntilEndOfTurn
    , temporaryEffect    = affectingSelf [ModifyPT (\_ -> return pt')]
    }

destroyTargetPermanent :: (Object -> Bool) -> Contextual (Magic ())
destroyTargetPermanent spec rSelf you = do
  ts <- askTarget you $ checkPermanent spec <?> targetPermanent
  stackTargetSelf rSelf you ts $ \t _stackSelf _stackYou ->
    will $ DestroyPermanent t True

simpleCreatureToken ::
  Timestamp -> PlayerRef -> [CreatureSubtype] -> [Color] -> PT -> Object
simpleCreatureToken t you tys cs pt' =
  (emptyObject t you)
  { _name = Just (Text.intercalate (Text.pack " ") (map textShow tys))
  , _colors = Set.fromList cs
  , _types = creatureTypes tys
  , _pt = Just pt'
  }

viewZone :: ZoneRef ty -> Magic [(ObjectRef ty, ObjectOfType ty)]
viewZone zoneRef = do
    idListEls <- IdList.toList <$> view (asks (compileZoneRef zoneRef))
    return [ ((zoneRef, i), o)| (i, o) <- idListEls ]