dovin 0.2 → 3.0

raw patch · 42 files changed

+1176/−1178 lines, 42 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +9/−13
• app/Main.hs +0/−1
• dovin.cabal +14/−27
• mtgtc/MTGTC.hs +0/−753
• mtgtc/Main.hs +0/−52
• src/Dovin.hs +2/−2
• src/Dovin/Actions.hs +119/−4
• src/Dovin/Attributes.hs +2/−0
• src/Dovin/Builder.hs +60/−14
• src/Dovin/Dump.hs +0/−82
• src/Dovin/Effects.hs +286/−0
• src/Dovin/Formatting.hs +6/−5
• src/Dovin/Helpers.hs +14/−128
• src/Dovin/Matchers.hs +104/−0
• src/Dovin/Runner.hs +42/−0
• src/Dovin/Types.hs +99/−8
• src/Dovin/V1.hs +37/−4
• src/Dovin/V2.hs +17/−7
• src/Dovin/V3.hs +39/−0
• src/Solutions/ChannelFireball.hs +4/−6
• src/Solutions/Core19_9.hs +4/−4
• src/Solutions/Dominaria5.hs +1/−1
• src/Solutions/Example.hs +5/−4
• src/Solutions/ExplorersOfIxalanContest.hs +3/−2
• src/Solutions/GuildsOfRavnica1.hs +15/−7
• src/Solutions/GuildsOfRavnica3.hs +1/−1
• src/Solutions/GuildsOfRavnica8.hs +3/−4
• src/Solutions/GuildsOfRavnica9.hs +2/−2
• src/Solutions/GuildsOfRavnicaPre2.hs +1/−1
• src/Solutions/RavnicaAllegiance3.hs +1/−1
• src/Solutions/RavnicaAllegiance4.hs +1/−2
• src/Solutions/RavnicaAllegiance5.hs +10/−11
• src/Solutions/RavnicaAllegiance7.hs +1/−1
• src/Solutions/RavnicaAllegiancePre2.hs +1/−6
• src/Solutions/RivalsOfIxalan7.hs +2/−2
• src/Solutions/UltimateMasters.hs +1/−1
• src/Solutions/WarOfTheSpark2.hs +26/−22
• test/AddEffect.hs +14/−0
• test/Effects.hs +136/−0
• test/Life.hs +14/−0
• test/Mentor.hs +71/−0
• test/TestPrelude/V3.hs +9/−0

@@ -21,9 +21,7 @@  I've only added actions "as needed" to solve problems, so the built-in functions are rather incomplete right now. It is straightforward to add more-though. See `src/Dovin/V2.hs` in conjuction with `src/Dovin/Actions.hs` for-supported and tested actions, and `src/Dovin/Dump.hs` for untested experimental-ones.+though. See `src/Dovin/V3.hs` in conjuction with `src/Dovin/Actions.hs`.  ## Example @@ -32,12 +30,10 @@  import Dovin -main = run formatter solution- solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 3+    as Opponent $ setLife 3      withLocation Hand $ addInstant "Plummet"     withLocation Play $ do@@ -48,9 +44,10 @@         withAttributes [flying, token] $ addCreature (4, 4) "Angel"         withAttributes [flying]           $ withEffect-              matchInPlay-              (matchOtherCreatures <> (const $ matchAttribute creature))-              (pure . setAttribute hexproof)+              (matchOtherCreatures <$> askSelf)+              [ effectAddAbility hexproof+              ]+              "Other creatures gain hexproof"           $ addCreature (3, 4) "Shalai, Voice of Plenty"    step "Plummet to destroy Shalai" $ do@@ -113,8 +110,8 @@   interactions. * `UltimateMasters` shows how to track opponent actions. * `ChannelFireball` automatically calculates High Tide mana.-* `WarOfTheSpark2` shows off a hack for effects that depend on attributes of-  other cards (hopefully will have a better fix in API soon!)+* `WarOfTheSpark2` shows how to define effects that depend on attributes of+  other cards.  ## Development @@ -122,8 +119,7 @@     bin/test # Runs all tests and lints     bin/run  # Runs all solutions -`src/Dovin/Dump.hs` is currently a dumping ground for prototype code. Actions-are in the process of being moved to `Dovin.Actions`. To be moved they must:+New actions go into `Dovin.Actions`. They must:    * Be unit tested.   * Be documented.

@@ -4,7 +4,6 @@ import Dovin  import qualified Solutions---import Solutions.MTGTC  main :: IO () --main = run formatter solution

@@ -1,13 +1,11 @@-cabal-version: 1.24---- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: b16ab68c041fd8e96b59020ab905d0b6ead290ba704b581b99316cb310e5e23f+-- hash: bc9b329ab69abe923a9afbf06794f3c6f3f53fd4d11f18c48959438b03454875  name:           dovin-version:        0.2+version:        3.0 synopsis:       A proof assistant for Magic: The Gathering puzzles. description:    Please see the README on GitHub at <https://github.com/xaviershay/dovin#dovin> category:       Games@@ -15,10 +13,11 @@ bug-reports:    https://github.com/xaviershay/dovin/issues author:         Xavier Shay maintainer:     contact@xaviershay.com-copyright:      2019 Xavier Shay+copyright:      2021 Xavier Shay license:        BSD3 license-file:   LICENSE build-type:     Custom+cabal-version:  >= 1.24 extra-source-files:     README.md @@ -39,14 +38,17 @@       Dovin.Actions       Dovin.Attributes       Dovin.Builder-      Dovin.Dump+      Dovin.Effects       Dovin.Formatting       Dovin.Helpers+      Dovin.Matchers       Dovin.Monad       Dovin.Prelude+      Dovin.Runner       Dovin.Types       Dovin.V1       Dovin.V2+      Dovin.V3       Solutions       Solutions.ChannelFireball       Solutions.Core19_9@@ -100,41 +102,25 @@     , unordered-containers   default-language: Haskell2010 -executable mtgtc-  main-is: Main.hs-  other-modules:-      MTGTC-      Paths_dovin-  hs-source-dirs:-      mtgtc-  ghc-options: -threaded -rtsopts -with-rtsopts=-N-  build-depends:-      base >=4.7 && <5-    , containers-    , dovin-    , hashable-    , lens-    , mtl-    , parsec-    , split-    , unordered-containers-  default-language: Haskell2010- test-suite dovin-test   type: exitcode-stdio-1.0   main-is: Driver.hs   other-modules:       Activate       ActivatePlaneswalker+      AddEffect       CopySpell       Counter       Damage       Destroy       Discard+      Effects       Exert       Fight       Flashback       Jumpstart+      Life+      Mentor       ModifyStrength       Move       Resolve@@ -146,6 +132,7 @@       TargetInLocation       TestPrelude       TestPrelude.V2+      TestPrelude.V3       TestSolutions       Trigger       Paths_dovin

@@ -1,753 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}---- https://arxiv.org/abs/1904.09828-module MTGTC where--import Dovin.V2-import Dovin.Prelude-import Dovin.Monad-import Data.List (intercalate)--import Control.Lens-import qualified Data.List-import qualified Data.Set-import qualified Data.Ord-import qualified Data.Map as M--import Data.List.Split (splitOneOf)--alice = Opponent-bob = Active---- Indicates that a card's color text has been changed by Glamerdye-colorHacked = "color-hacked"-phasing = "phasing"-phasedOut = "phasedOut"--shroud = "shroud"--aetherborn = "aetherborn"-basilisk = "basilisk"-cephalid = "cephalid"-demon = "demon"-elf = "elf"-faerie = "fairie"-giant = "giant"-harpy = "harpy"-illusion = "illusion"-juggernaut = "juggernaut"-kavu = "kavu"-leviathan = "leviathan"-myr = "myr"-noggle = "noggle"-orc = "orc"-pegasus = "pegasus"-rhino = "rhino"-sliver = "sliver"--lyurgoyf = "lyurgoyf"-rat = "rat"--tapeTypes =-  [ aetherborn-  , basilisk-  , cephalid-  , demon-  , elf-  , faerie-  , giant-  , harpy-  , illusion-  , juggernaut-  , kavu-  , leviathan-  , myr-  , noggle-  , orc-  , pegasus-  , rhino-  , sliver--  , assassin-  , lyurgoyf-  , rat-  ]--unicodeMappings = M.fromList-  [ (aetherborn, "1 ")-  , (basilisk, "1⃗ ")-  , (cephalid, "1⃖ ")-  , (demon, "1⃗₁")-  , (elf, "1⃖₁")-  , (faerie, "b ")-  , (giant, "b⃗ ")-  , (harpy, "b⃖ ")-  , (illusion, "b⃗₁")-  , (juggernaut, "b⃖₁")-  , (kavu, "b₂")-  , (leviathan, "b₃")-  , (myr, "c ")-  , (noggle, "c⃗ ")-  , (orc, "c⃖ ")-  , (pegasus, "c⃗₁")-  , (rhino, "c⃖₁")-  , (sliver, "c₂")--  , (assassin, "!!")-  , (lyurgoyf, "L ")-  , (rat, "R ")-  ]--assassin = "assassin"-assemblyWorker = "assembly-worker"--white = "white"-blue = "blue"-black = "black"-red = "red"-green = "green"-allColors = [white, blue, black, red, green]--extractColors = Data.Set.toList . Data.Set.intersection (Data.Set.fromList [white, blue, black, red, green]) . view cardAttributes--castWithWildEvocation = castNoRestrictions ""--castNoRestrictions mana name = do-  card <- requireCard name mempty-  spendMana mana-  modifyCard (location . _2) (const Stack) name-  modifying-    stack-    ((:) name)-  when-    (hasAttribute sorcery card || hasAttribute instant card) $-    modifying-      (counters . at storm . non 0)-      (+ 1)--draw :: CardName -> GameMonad ()-draw expectedName = do-  active <- view envActor-  s <- use $ deck . at active . non mempty--  case s of-    [] -> throwError $ "deck is empty, expecting " <> expectedName-    (name:cs) -> do-      unless (name == expectedName) $-        throwError $ "unexpected top of deck: expected "-                       <> expectedName-                       <> ", got "-                       <> name-      moveTo Hand expectedName-      modifying-        (deck . at alice . non mempty)-        (drop 1)--mill :: CardName -> GameMonad ()-mill expectedName = do-  active <- view envActor-  s <- use $ deck . at active . non mempty--  case s of-    [] -> throwError $ "deck is empty, expecting " <> expectedName-    (name:cs) -> do-      unless (name == expectedName) $-        throwError $ "unexpected top of deck: expected "-                       <> expectedName-                       <> ", got "-                       <> name-      moveTo Graveyard expectedName-      modifying-        (deck . at active . non mempty)-        (drop 1)--drawTop = do-  active <- view envActor-  s <- use $ deck . at active . non mempty--  case s of-    [] -> throwError $ "deck is empty"-    (name:cs) -> do-      moveTo Hand name-      modifying-        (deck . at active . non mempty)-        (drop 1)--phaseCards owner = do-  forCards (matchAttribute phasing <> matchController owner) $ \cn -> do-    c <- requireCard cn mempty--    if hasAttribute phasedOut c then-      loseAttribute phasedOut cn-    else-      gainAttribute phasedOut cn--findM :: (a -> GameMonad ()) -> [a] -> GameMonad a-findM f [] = throwError "No matching element"-findM f (x:xs) = (f x >> return x) `catchError` (\_ -> findM f xs)---- Technically the card should never hit the graveyard, but that's not relevant--- in this proof. Instead, move from graveyard to bottom of deck.-wheelOfSunAndMoon name = do-  active <- view envActor-  validate (matchLocation (active, Graveyard)) name-  moveTo Deck name-  modifying-    (deck . at active . non mempty)-    (\xs -> xs ++ [name])--lookupSingleCard :: CardMatcher -> GameMonad Card-lookupSingleCard matcher = do-  matchingCs <- lookupCards matcher--  case matchingCs of-    [] -> throwError $ "No matches: " <> show matcher-    [x] -> return x-    xs -> throwError $ "Ambigious match: " <> (intercalate ", " . map (view cardName) $ xs)--lookupCards :: CardMatcher -> GameMonad [Card]-lookupCards matcher = do-  cs <- allCards--  return $ filter (applyMatcher matcher) cs--whenNotHalted m = do-  halted <- gameFinished--  unless halted m--whenState f m = do-  result <- (f >> pure True) `catchError` (const $ pure False)--  when result m--data State = Q1 | Q2 deriving (Show, Eq)--data Rule = Rule-  { _ruleState :: State-  , _ruleNumber :: Int-  , _ruleTrigger :: CardAttribute-  , _ruleAttributes :: [CardAttribute]-  }-makeLenses ''Rule--mkRule s n trigger attributes = Rule-  { _ruleState = s-  , _ruleNumber = n-  , _ruleTrigger = trigger-  , _ruleAttributes = attributes-  }--instance Show Rule where-  show = triggeringCreature--triggeringCreature rule =-  let baseCreature = if tapped `elem` view ruleAttributes rule then-                       "Xathrid Necromancer"-                     else-                       "Rotlung Reanimator"-  in--  baseCreature <> " " <> show (view ruleState rule) <> " " <> show (view ruleNumber rule)---rules =-  [ mkRule Q1 1 aetherborn [sliver, white]-  , mkRule Q1 2 basilisk [green, elf]-  , mkRule Q1 3 cephalid [sliver, white]-  , mkRule Q1 4 demon [green, aetherborn]-  , mkRule Q1 5 elf [white, demon]-  , mkRule Q1 6 faerie [green, harpy]-  , mkRule Q1 7 giant [green, juggernaut]-  , mkRule Q1 8 harpy [white, faerie]-  , mkRule Q1 9 illusion [green, faerie]-  , mkRule Q1 10 juggernaut [white, illusion]-  , mkRule Q1 11 kavu [white, leviathan, tapped]-  , mkRule Q1 12 leviathan [white, illusion, tapped]-  , mkRule Q1 13 myr [white, basilisk, tapped]-  , mkRule Q1 14 noggle [green, orc]-  , mkRule Q1 15 orc [white, pegasus]-  , mkRule Q1 16 pegasus [green, rhino, tapped]-  , mkRule Q1 17 rhino [assassin, blue]-  , mkRule Q1 18 sliver [green, cephalid]-  , mkRule Q2 1 aetherborn [green, cephalid]-  , mkRule Q2 2 basilisk [green, cephalid]-  , mkRule Q2 3 cephalid [white, basilisk]-  , mkRule Q2 4 demon [green, elf]-  , mkRule Q2 5 elf [white, aetherborn]-  , mkRule Q2 6 faerie [green, kavu, tapped]-  , mkRule Q2 7 giant [green, harpy]-  , mkRule Q2 8 harpy [white, giant]-  , mkRule Q2 9 illusion [green, juggernaut]-  , mkRule Q2 10 juggernaut [white, giant]-  , mkRule Q2 11 kavu [green, faerie, tapped]-  , mkRule Q2 12 leviathan [green, juggernaut]-  , mkRule Q2 13 myr [green, orc]-  , mkRule Q2 14 noggle [green, orc]-  , mkRule Q2 15 orc [white, noggle]-  , mkRule Q2 16 pegasus [green, sliver]-  , mkRule Q2 17 rhino [white, sliver, tapped]-  , mkRule Q2 18 sliver [white, myr]-  ]--mappings = M.fromList-  . map (\x -> (head x, x))-  . Data.List.delete rat-  . Data.List.delete lyurgoyf-  . Data.List.delete assassin-  $ tapeTypes--charToType :: Char -> GameMonad CardAttribute-charToType c = do-  case M.lookup c mappings of-    Nothing -> throwError ("Unknown tape symbol: " <> [c])-    Just x -> return x--encodeTape :: String -> GameMonad ()-encodeTape xs = do-  let [ls, (c:_), rs] = splitOneOf "[]" xs--  forM_ (zip (reverse ls) [3..]) $ \(l, s) -> do-    t <- charToType l-    withAttributes [token, green, t] $ addCreature (s, s) ("Initial L" <> show s)--  t <- charToType c-  withAttributes [token, t] $ addCreature (2, 2) ("Initial C")--  forM_ (zip rs [3..]) $ \(l, s) -> do-    t <- charToType l-    withAttributes [token, white, t] $ addCreature (s, s) ("Initial R" <> show s)--  let n = length ls + 2--  withAttributes [green, lyurgoyf, token] $ addCreature (n, n) "Lyurgoyf Left Tape"--  let n = length rs + 2-  withAttributes [white, rat, token] $ addCreature (n, n) "Rat Right Tape"--setup :: String -> GameMonad ()-setup tape = do-  transitionToForced Untap--  as alice $ do-    withLocation Hand $ do-      addSorcery "Infest"--    withLocation Deck $ do-      addInstant "Cleansing Beam"-      addSorcery "Coalition Victory"-      withAttribute black $ addCreature (3, 3) "Soul Snuffers"--      assign-        (deck . at alice)-        (Just ["Cleansing Beam", "Coalition Victory", "Soul Snuffers"])--    withLocation Play $ do-      addArtifact "Mesmeric Orb"-      addAura "Illusory Gains"-      withAttributes allColors $ addLand "Island"-      withAttribute green $ addEnchantment "Choke"-      -- TODO: This should be (2, 2), but then dread of night/infest kills it?-      withAttributes [red, green, white, black, assemblyWorker] $ addCreature (5, 5) "Fungus Sliver"-      withEffect-        matchInPlay-        (pure $ matchAttribute creature <> matchAttribute assemblyWorker)-        (pure . setAttribute shroud)-        $ addEnchantment "Steely Resolve"--  as bob $ do-    withLocation Play $ do-      encodeTape tape-      -- "[p]fr"-      --encodeTape "" 's' "sr"-      --encodeTape "crrffafafaffaffaaaaaaafaaaaaf" 'f' "amamamc"-      addEnchantment "Wild Evocation"--      withEffect-        matchInPlay-        (const $ matchAttribute creature <> matchAttribute black)-        (pure . over cardStrengthModifier (mkStrength (-1, -1) <>))-        $ withAttribute colorHacked-        $ addEnchantment "Dread of Night 1"--      withEffect-        matchInPlay-        (const $ matchAttribute creature <> matchAttribute black)-        (pure . over cardStrengthModifier (mkStrength (-1, -1) <>))-        $ withAttribute colorHacked-        $ addEnchantment "Dread of Night 2"--      withEffect-        matchInPlay-        (const $ matchAttribute creature <> matchAttribute rat)-        (pure . over cardStrengthModifier (mkStrength (1, 1) <>))-        $ addEnchantment "Shared Triumph 1"--      withEffect-        matchInPlay-        (const $ matchAttribute creature <> matchAttribute lyurgoyf)-        (pure . over cardStrengthModifier (mkStrength (1, 1) <>))-        $ addEnchantment "Shared Triumph 2"--      -- TODO: setup this color pallete from black-      forM_ rules $ \rule -> do-        let name = triggeringCreature rule--        let extraAttributes = if view ruleState rule == Q2 then-                                [phasedOut]-                              else-                                []-        withAttributes [red, green, black, white]-          $ withAttributes (phasing:extraAttributes)-          $ addCreature (2, 2) name--      withEffect-        matchInPlay-        (matchLocation . view cardLocation)-        (pure . setAttribute hexproof)-        $ addEnchantment "Privileged Position"--stepCompute :: Int -> GameMonad ()-stepCompute n = do-  runLoop n--runLoop n = do-  turn1 n-  turn2 n--  whenState (validate (matchLocation (alice, Hand)) "Coalition Victory") $ do-    turn3 n---  whenNotHalted $ do-    turn4 n--turnStep c n l = step ("Cycle " <> show c <> ", Turn " <> show n <> ": " <> l)--turn1 n = do-  turnStep n 1 "Alice: Untap" $ do-    transitionToForced Untap-    phaseCards alice--  deadToken <- turnStep n 1 "Upkeep: Infest" $ do-    transitionTo Upkeep--    as bob $ do-      trigger "Force cast" "Wild Evocation" >> resolveTop--    as alice $ do-      _ <- lookupSingleCard (matchLocation (alice, Hand) <> matchName "Infest")--      castWithWildEvocation "Infest" >> resolveTop-      wheelOfSunAndMoon "Infest"--    forCards (matchInPlay <> matchAttribute creature) $-      modifyCard cardStrengthModifier (mkStrength (-2, -2) <>)--    lookupSingleCard (matchInPlay <> matchAttribute creature <> matchLesserPower 1)--  deadToken' <--    if (hasAttribute rat deadToken) then-      do-        -- Handle infinite tape on right side-        -- TODO: Trigger and resolve things, don't just create creatures-        as bob $ do-          -- TODO: Illusory gains, though shouldn't be relevant-          withLocation Play $-            withAttributes [rat, white, token] $ addCreature (2, 2) ("Rat " <> show n)--        as alice $ do-          withLocation Play $-            withAttributes [cephalid, black, token] $ addCreature (2, 2) ("Cephalid " <> show n)--        requireCard ("Cephalid " <> show n) (matchLesserPower 1)-    else if (hasAttribute lyurgoyf deadToken) then-      do-        -- Handle infinite tape on right side-        -- TODO: Trigger and resolve things, don't just create creatures-        as bob $ do-          -- TODO: Illusory gains, though shouldn't be relevant-          withLocation Play $-            withAttributes [lyurgoyf, green, token] $ addCreature (2, 2) ("Lyurgoyf " <> show n)--        as alice $ do-          withLocation Play $-            withAttributes [cephalid, black, token] $ addCreature (2, 2) ("Cephalid " <> show n)--        requireCard ("Cephalid " <> show n) (matchLesserPower 1)-    else-      return deadToken--  let matchingRules =-        filter-          (\rule -> hasAttribute (view ruleTrigger rule) deadToken')-          rules--  when (null matchingRules) $-    throwError ("Unknown card died: " <> formatCard deadToken)--  rule <- findM-            (validate (missingAttribute phasedOut) . triggeringCreature)-            matchingRules--  let c = triggeringCreature rule--  turnStep n 1 ("Action: " <> show rule) $ do-    as bob $ do-      trigger (c <> " Trigger") c >> resolveTop--      withLocation Play-        $ withAttributes (token : view ruleAttributes rule)-        $ addCreature (2, 2) ("Token " <> show n)--  turnStep n 1 "Illusory Gains" $ do-    as alice $ do-      trigger "Steal" "Illusory Gains" >> resolveTop-      -- TODO: Better tracking of what Illusory Gains is attached to-      forCards (matchController alice <> matchAttributes [creature, token] <> matchInPlay) $-        move (alice, Play) (bob, Play)-      move (bob, Play) (alice, Play) ("Token " <> show n)--  turnStep n 1 "Draw" $ do-    transitionTo DrawStep-    as alice $ draw "Cleansing Beam"--    -- TODO: Validate alice can't do anything--  turnStep n 1 "EoT: Undo infest -2/-2" $ do-    forCards (matchInPlay <> matchAttribute creature) $-      modifyCard cardStrengthModifier (const $ mkStrength (0, 0))--  turnStep n 1 "Bob: Untap and Phase" $ do-    phaseCards bob--turn2 n = do-  turnStep n 2 "Alice Untap" $ do-    transitionToForced Untap-    phaseCards alice--    as alice $ do-      tappedCard <- lookupCards (matchController alice <> matchAttribute tapped)--      case tappedCard of-        [] -> return ()-        [c] -> do-          let cn = view cardName c-          untap cn-          -- No priority in untap phase, to this doesn't technically go on stack until Upkeep-          trigger "Mill" "Mesmeric Orb"--        cs -> throwError $ "Too many tapped cards: " <> intercalate ", " (map (view cardName) cs)---  turnStep n 2 "Upkeep: Cleansing Beam" $ do-    transitionTo Upkeep--    as bob $ do-      trigger "Force cast" "Wild Evocation" >> resolveTop--    as alice $ do-      _ <- lookupSingleCard-             (  matchLocation (alice, Hand)-             <> matchName "Cleansing Beam"-             )--      castWithWildEvocation "Cleansing Beam" >> resolveTop-      wheelOfSunAndMoon "Cleansing Beam"--      card <- lookupSingleCard-                (  matchInPlay-                <> matchAttribute creature-                <> missingAttribute shroud-                <> missingAttribute hexproof-                )-      target (view cardName card)--      forCards (-          matchAttribute creature-          <> (foldl (\b a -> matchAttribute a `matchOr` b) (invert mempty) (extractColors card))-        ) $ \cn -> do-          -- TODO: Check for vigor-          modifyCard cardPlusOneCounters (+ 2) cn--  turnStep n 2 "Mill from Mesmeric Orb (if triggered)" $ do-    s <- use $ stack--    as alice $ do-      when (not . null $ s) $ do-        resolve "Mill"-        mill "Coalition Victory"-        wheelOfSunAndMoon "Coalition Victory"--  turnStep n 2 "Alice Draw" $ do-    transitionTo DrawStep-    as alice $ drawTop--  turnStep n 2 "Bob: Untap and Phase" $ do-    phaseCards bob--turn3 n = do-  turnStep n 3 "Upkeep: Coalition Victory" $ do-    transitionToForced Untap-    phaseCards alice--    transitionTo Upkeep--    as bob $ do-      trigger "Force cast" "Wild Evocation" >> resolveTop--    as alice $ do-      _ <- lookupSingleCard-             (  matchLocation (alice, Hand)-             <> matchName "Coalition Victory"-             )--      castWithWildEvocation "Coalition Victory" >> resolveTop--      matches <--        sequence-          . map (\(c, t) -> (not . null) <$> lookupCards (matchController alice <> matchAttributes [c, t]))-           $ [(x, y) | x <- allColors, y <- [creature, land]]--      if (Prelude.all id matches) then-        throwError "won game"-      else-        wheelOfSunAndMoon "Coalition Victory"--  whenNotHalted $ do-    turnStep n 3 "Alice Draw" $ do-      transitionTo DrawStep-      as alice $ draw "Soul Snuffers"--  turnStep n 3 "Bob: Untap and Phase" $ do-    phaseCards bob--turn4 n = do-  turnStep n 4 "Upkeep: Soul Snuffers" $ do-    transitionToForced Untap-    phaseCards alice-    transitionTo Upkeep--    as bob $ do-      trigger "Force cast" "Wild Evocation" >> resolveTop--    as alice $ do-      _ <- lookupSingleCard-             (  matchLocation (alice, Hand)-             <> matchName "Soul Snuffers"-             )--      castWithWildEvocation "Soul Snuffers" >> resolveTop--      withStateBasedActions $ do-        forCards (matchInPlay <> matchAttribute creature) $-          modifyCard cardMinusOneCounters (+ 1)--      wheelOfSunAndMoon "Soul Snuffers"---  turnStep n 4 "Alice Draw" $ do-    transitionTo DrawStep-    as alice $ draw "Infest"--  turnStep n 4 "Bob: Untap and Phase" $ do-    phaseCards bob--matchAny = foldl (\b a -> a `matchOr` b) (invert mempty)--tapeFormatter :: Formatter-tapeFormatter board =-  let f matcher = Data.List.sortBy (Data.Ord.comparing tapePosition)-            . filter (applyMatcher $ matcher <> matchAny (map matchAttribute tapeTypes))-             $ cs in--  let leftCs = f (matchAttribute green <> invert (matchToughness 2)) in-  let rightCs = f (matchAttribute white <> invert (matchToughness 2)) in-  let centerCs = f (matchToughness 2) in--  let tapeValid = length centerCs == 1-                  && contiguous (map (view cardToughness) leftCs)-                  && contiguous (map (view cardToughness) rightCs)-                  && (null leftCs || minimum (map (view cardToughness) leftCs) == 3)-                  && (null rightCs || minimum (map (view cardToughness) rightCs) == 3)-                in--  let tapeWithHead = map extractSymbol (reverse leftCs) <> "[" <> map extractSymbol centerCs <> "]" <> map extractSymbol rightCs in--  if tapeValid then-    tapeWithHead-  else-    ""--  where-    cs = let Right value = execMonad board allCards in value-    tapePosition c = view cardPower c--stateFormatter :: Formatter-stateFormatter board =-  let expr = requireCard "Rotlung Reanimator Q1 1" mempty in-  let Right value = execMonad board expr in--  if hasAttribute phasedOut value then-    "Q2: "-  else-    "Q1: "--tapeFormatter2 :: Formatter-tapeFormatter2 board =-  let f matcher = Data.List.sortBy (Data.Ord.comparing tapePosition)-            . filter (applyMatcher $ matcher <> matchAny (map matchAttribute tapeTypes))-             $ cs in--  let leftCs = f (matchAttribute green <> invert (matchToughness 2)) in-  let rightCs = f (matchAttribute white <> invert (matchToughness 2)) in-  let centerCs = f (matchToughness 2) in--  let tapeValid = length centerCs == 1-                  && contiguous (map (view cardToughness) leftCs)-                  && contiguous (map (view cardToughness) rightCs)-                in--  let tapeWithHead =-          formatSymbols (reverse leftCs) <> ">" <>-            formatSymbols centerCs <> " " <>-            formatSymbols rightCs in--  if tapeValid then-    tapeWithHead-  else-    "\ntape invalid"--  where-    cs = let Right value = execMonad board allCards in value-    tapePosition c = view cardPower c-    formatSymbols = intercalate " " . map extractSymbol2--extractSymbol c = if hasAttribute assassin c then 'H' else head . head . Data.Set.toList $ (Data.Set.fromList tapeTypes) `Data.Set.intersection` (view cardAttributes c)--extractSymbol2 :: Card -> String-extractSymbol2 c = -  case M.lookup relevantAttribute unicodeMappings of-    Nothing -> "? "-    Just x -> x--  where-    relevantAttribute =-      head-      .  Data.Set.toList-      $ (Data.Set.fromList tapeTypes)-          `Data.Set.intersection`-          (view cardAttributes c)--matchOwner :: Player -> CardMatcher-matchOwner x = CardMatcher ("owner " <> show x) $-  (==) x . fst . view cardLocation--contiguous xs = Prelude.all (\(x, y) -> y - x == 1) $ zip xs (tail xs)--deckFormatter actor board = "\n      deck: " <> intercalate "" (map (\cn -> "\n        " <> cn) (view (deck . at actor . non mempty) board))-formatter step = case view stepNumber step of-  _ -> tapeFormatter---    <> cardFormatter "tape (bob)" (matchAny (map matchAttribute tapeTypes) <> matchOwner bob)---    <> cardFormatter "tape (alice)" (matchAny (map matchAttribute tapeTypes) <> matchOwner alice)---    <> deckFormatter alice

@@ -1,52 +0,0 @@-module Main where--import Dovin.V2-import Dovin.Prelude-import Dovin.Monad--import qualified MTGTC--import System.Exit (exitFailure, exitSuccess)--main = do-  --let tape = "[s]ssr"-  --let tape = "[p]fr"-  --let tape =  "crrffafafaffaffaaaaaaafaaaaaf[f]amamamc"-  --let tape = "rrffafafaf[f]amamam"-  let tape = "rrffaafaf[f]amam"-  let tape = "rrffaaaaaaaaaaaffaaaaaaaaaaaafaaaaaaaaaaaafaaaaaaaaaaaffaaaaaaaaaffaaaaaf[f]amaaamaaamaaam"-  --let tape = "[s]"--  let (e, initialBoard, _) = runMonad emptyBoard (MTGTC.setup tape)-  putStrLn . myFormatter $ initialBoard-  _ <- foldM runCycle initialBoard [1..]-  putStrLn "Done"--fixupFinalBoard = do-  forCards (matchAttribute MTGTC.assassin) $-    modifyCard cardStrengthModifier (mkStrength (-2, -2) <>)--runCycle :: Board -> Int -> IO Board-runCycle board n = do-  let (e, newBoard, log) = runMonad board (MTGTC.stepCompute n)--  case e of-    Left "won game" -> do-      let (e, finalBoard, log) = runMonad newBoard fixupFinalBoard-      putStrLn ""-      putStrLn . MTGTC.tapeFormatter2 $ finalBoard-      exitSuccess-    Left x -> putStrLn x >> exitFailure-    Right _ -> do-      putStrLn . myFormatter $ newBoard-    --  putStrLn . myFormatter $ newBoard-    --  forM_ log $ \step -> do-    --    putStr $ show (view stepNumber step) <> ". "-    --    putStr $ view stepLabel step-    --    putStrLn . myFormatter . view stepState $ step-      return newBoard--myFormatter =-     MTGTC.stateFormatter-  <> MTGTC.tapeFormatter2-    -- <> cardFormatter "tape" (MTGTC.matchAny (map matchAttribute MTGTC.tapeTypes))

@@ -1,5 +1,5 @@ module Dovin-  ( module Dovin.V2+  ( module Dovin.V3   ) where -import Dovin.V2+import Dovin.V3

@@ -19,6 +19,7 @@   , jumpstart   , resolve   , resolveTop+  , resolveMentor   , splice   , tapForMana   , target@@ -26,6 +27,7 @@   -- * Uncategorized   , activate   , activatePlaneswalker+  , addEffect   , attackWith   , combatDamage   , copySpell@@ -35,12 +37,16 @@   , exert   , exile   , fight+  , gainLife+  , loseLife   , modifyStrength   , moveTo   , sacrifice+  , setLife   , transitionTo   , transitionToForced   , trigger+  , triggerMentor   , with   -- * Validations   , validate@@ -70,7 +76,9 @@ import           Dovin.Prelude import           Dovin.Types import           Dovin.Builder-import Dovin.Monad+import           Dovin.Monad+import           Dovin.Matchers+import           Dovin.Effects (resolveEffects)  import qualified Data.HashMap.Strict as M import Data.Maybe (listToMaybe)@@ -263,7 +271,6 @@        resolveTop - -- | Resolves the top card of the stack. Use this for simple cast-and-resolve -- scenarios. For more complicated stack states, prefer 'resolve' with a named -- spell to ensure the expected one is resolving.@@ -297,6 +304,33 @@        assign stack xs +-- | Resolves a trigger created by `triggerMentor`. Adds +1/+1 to target card+-- if still a valid mentor target.+--+-- > resolveMentor "Goblin 1" "Legion Warboss"+--+-- [Validates]+--+--   * Mentor trigger is top of stack.+--   * Target card is attacking.+--   * Target card has less power than source card.+--+-- [Effects]+--+--   * Target card gets +1/+1.+--   * Trigger is removed from top of stack.+resolveMentor targetName sourceName = do+  let triggerName = "Mentor " <> targetName <> " from " <> sourceName++  resolve triggerName++  source <- requireCard sourceName mempty+  _      <- requireCard targetName $+                 matchAttribute attacking+              <> matchLesserPower (view cardPower source)++  modifyStrength (1, 1) targetName+ -- | Sacrifice a permanent. -- -- > sacrifice "Soldier"@@ -413,6 +447,31 @@     stack     ((:) triggerName) +-- | Triggers a mentor effect from an attacking creature, targeting another+-- attacking creature with lesser power. Typically you will want to+-- `resolveMentor` after triggering.+--+-- > triggerMentor "Goblin 1" "Legion Warboss"+--+-- [Validates]+--+--   * Source card has attacking and mentor attributes.+--   * Target card is attacking.+--   * Target card has less power than source card.+--+-- [Effects]+--+--   * A triggered card is placed on the stack.+triggerMentor :: CardName -> CardName -> GameMonad ()+triggerMentor targetName sourceName = do+  source <- requireCard sourceName $ matchAttributes [attacking, mentor]+  _      <- requireCard targetName $+                 matchAttribute attacking+              <> matchLesserPower (view cardPower source)++  trigger ("Mentor " <> targetName <> " from " <> sourceName) sourceName++ -- | Helper function to provide a scoped let. -- -- > with "Angel" $ \cn -> target cn >> destroy cn@@ -704,6 +763,8 @@     stack     ((:) newName) +  resolveEffects+ -- | Applies damage from a source to a target. -- -- > damage (const 2) (targetPlayer Opponent) "Shock"@@ -741,9 +802,9 @@     throwError $ "damage must be positive, was " <> show dmg    damage' dmg t c-   when (hasAttribute lifelink c) $     modifying (life . at (fst . view location $ c) . non 0) (+ dmg)+  resolveEffects    where     damage' dmg (TargetPlayer t) c =@@ -898,6 +959,7 @@ remove cn = do   modifying cards (M.delete cn)   modifying stack (filter (/= cn))+  resolveEffects  -- | Remove mana from the pool. Colored mana will be removed first, then extra -- mana of any type will be removed to match the colorless required.@@ -1143,7 +1205,7 @@     Left x -> throwError x     Right y -> return y --- | Branch off a labeled alternative line. Steps inside the fork will be+-- | Branch off a labeled alternate line. Steps inside the fork will be -- reported at the end of the main line output. fork :: String -> GameMonad () -> GameMonad () fork label m = do@@ -1157,3 +1219,56 @@   where     f label Nothing = Just label     f label (Just existing) = Just $ existing <> " - " <> label++-- | Increments life total for current actor.+--+-- > as Opponent $ gainLife 1+--+-- [Effects]+--+--   * Increases life total by amount+gainLife :: Int -> GameMonad ()+gainLife amount = do+  actor <- view envActor+  modifying+    (life . at actor . non 0)+    (+ amount)+  resolveEffects++-- | Decrements life total for current actor.+--+-- > as Opponent $ loseLife 1+--+-- [Effects]+--+--   * Decreases life total by amount+loseLife :: Int -> GameMonad ()+loseLife amount = gainLife (-amount)++-- | Sets life total for current actor.+--+-- > as Opponent $ setLife 1+--+-- [Effects]+--+--   * Sets life total to amount+setLife :: Int -> GameMonad ()+setLife n = do+  actor <- view envActor+  assign (life . at actor) (Just n)++-- | Adds an "until end of turn" effect to a card. Note in practice, since+-- turns aren't modeled, the effect will stay around until the end of the+-- solution.+--+-- > addEffect (effectPTSet 1 1) "Soldier"+--+-- [Effects]+--+--   * Adds a new "until end of turn" effect to the card with the current+--   timestamp.+addEffect :: LayeredEffectPart -> CardName -> GameMonad ()+addEffect e cn = do+  now <- getTimestamp++  modifyCard cardAbilityEffects (AbilityEffect now EndOfTurn [e]:) cn

@@ -58,6 +58,8 @@ legendary = "legendary" lifelink :: CardAttribute lifelink = "lifelink"+mentor :: CardAttribute+mentor = "mentor" planeswalker :: CardAttribute planeswalker = "planeswalker" sorcery :: CardAttribute

@@ -24,29 +24,43 @@   , as   , withAttribute   , withAttributes+  , withCMC   , withEffect+  , withEffectWhen   , withLocation+  , withOwner   , withPlusOneCounters   , withMinusOneCounters   ) where -import Control.Monad.Reader (ask, local)-import qualified Data.HashMap.Strict as M-import qualified Data.Set as S- import Dovin.Attributes---import Dovin.Actions import Dovin.Prelude import Dovin.Types+import Dovin.Helpers (getTimestamp)+import Dovin.Matchers (matchNone)+import Dovin.Effects (resolveEffects, enabledInPlay) +import Control.Monad.Reader (local)+import Control.Lens (_1)+import qualified Data.HashMap.Strict as M+import qualified Data.Set as S+ addCard :: CardName -> GameMonad () addCard name = do   card <- use $ cards . at name+  now <- getTimestamp+   case card of     Just _ -> throwError $ "Card should be removed: " <> name     Nothing -> do       template <- view envTemplate-      modifying cards (M.insert name (BaseCard $ set cardName name template))+      owner <- view envOwner+      modifying cards (M.insert name (BaseCard+        $ set cardName name+        . set cardTimestamp now+        . set cardOwner (maybe (view (cardLocation . _1) template) id owner)+        $ template))+      resolveEffects  addAura :: CardName -> GameMonad () addAura name = withAttribute aura $ addEnchantment name@@ -98,23 +112,55 @@   local (over (envTemplate . cardAttributes) f        . over (envTemplate . cardDefaultAttributes) f) --- | Add an effect to the created card.+-- | Add an effect to the created card. The effect will only apply when the+-- card is in play. withEffect ::-  CardMatcher -- ^ A matcher that must apply to this card for this affect to-              -- apply. 'matchInPlay' is a typical value.- -> (Card -> CardMatcher) -- ^ Given the current card, return a matcher that-                          -- matches cards that this affect applies to.- -> (Card -> GameMonad Card) -- ^ Apply an effect to the given card.+    EffectMonad CardMatcher -- ^ The set of cards to apply the effect to+ -> [LayeredEffectPart]     -- ^ The effect to apply+ -> EffectName              -- ^ Human-readable description, cosmetic only.  -> GameMonad ()  -> GameMonad ()-withEffect applyCondition filter action =-  local (over (envTemplate . cardEffects) (mkEffect applyCondition filter action:))+withEffect = withEffectWhen enabledInPlay +-- | A more flexible version of 'withEffect' that allows customization of then+-- the effect should apply.+withEffectWhen ::+    EffectMonad Bool        -- ^ Effect only applies when this returns true+ -> EffectMonad CardMatcher -- ^ The set of cards to apply the effect to+ -> [LayeredEffectPart]     -- ^ The effect to apply+ -> EffectName              -- ^ Human-readable description, cosmetic only.+ -> GameMonad ()+ -> GameMonad ()+withEffectWhen enabled appliesTo effect name =+  local (over (envTemplate . cardPassiveEffects)+  (mkLayeredEffectPart combinedMatcher effect name:))++  where+    combinedMatcher :: EffectMonad CardMatcher+    combinedMatcher = do+      isEnabled <- enabled++      if isEnabled then+        appliesTo+      else+        return matchNone++-- | Set the converted mana cost of the created card.+withCMC :: Int -> GameMonad () -> GameMonad ()+withCMC n =+  local (set (envTemplate . cardCmc) n)++-- | Place the created card into a specific location. withLocation :: Location -> GameMonad () -> GameMonad () withLocation loc m = do   p <- view envActor    local (set (envTemplate . cardLocation) (p, loc)) m++-- | Set the owner for the created card. If not specified, defaults to the+-- owner of the card location.+withOwner :: Player -> GameMonad () -> GameMonad ()+withOwner owner = local (set envOwner (Just owner))  -- | Set the number of +1/+1 counters of the created card. withPlusOneCounters :: Int -> GameMonad () -> GameMonad ()

@@ -1,82 +0,0 @@--- Dumping ground for things that haven't been thought through or tested yet.-module Dovin.Dump where--import Control.Arrow (second)-import Control.Lens-import Control.Monad.Except-import Control.Monad.State-import Control.Monad.Writer-import qualified Data.HashMap.Strict as M-import qualified Data.Set as S-import System.Exit-import Data.List (groupBy, sort, sortBy)-import Data.Ord (comparing)-import Data.Function (on)-import Debug.Trace--import Dovin.Actions-import Dovin.Attributes-import Dovin.Builder-import Dovin.Formatting-import Dovin.Helpers-import Dovin.Monad-import Dovin.Types---- TODO: Better name (resolveMentor?), check source has mentor attribute-triggerMentor sourceName targetName = do-  source <- requireCard sourceName $ matchAttribute attacking-  _      <- requireCard targetName $-                 matchAttribute attacking-              <> matchLesserPower (view cardPower source)--  modifyStrength (1, 1) targetName--gainLife :: Player -> Int -> GameMonad ()-gainLife player amount =-  modifying-    (life . at player . non 0)-    (+ amount)--loseLife :: Player -> Int -> GameMonad ()-loseLife player amount = gainLife player (-amount)--setLife :: Player -> Int -> GameMonad ()-setLife p n = assign (life . at p) (Just n)--fork :: [GameMonad ()] -> GameMonad ()-fork options = do-  b <- get-  let cs = view currentStep b--  forM_ options $ \m -> do-    m-    put $ set currentStep cs b--run :: (Step -> Formatter) -> GameMonad () -> IO ()-run formatter solution = do-  let (e, _, log) = runMonad emptyBoard solution--  let groupedSteps =-        groupBy ((==) `on` view stepFork) . sortBy (comparing $ view stepId ) $ log--  forM_ groupedSteps $ \steps -> do-    case view stepFork $ head steps of-      Just l -> do-        putStrLn ""-        putStrLn $ "=== ALTERNATIVE: " <> l-        putStrLn ""-      Nothing -> return ()--    forM_ steps $ \step -> do-      putStr $ show (view stepNumber step) <> ". "-      putStr $ view stepLabel step-      putStrLn . formatter step . view stepState $ step--  putStrLn ""-  case e of-    Left x -> do-      putStrLn "ERROR:"-      putStrLn x-      putStrLn ""-      System.Exit.exitFailure-    Right _ -> return ()

@@ -0,0 +1,286 @@+{-# LANGUAGE TemplateHaskell #-}++{-|+Effects are continuous effects, such as "other creatures get +1/+1".++They are typically added to a card using 'Dovin.Builder.withEffect' or 'Dovin.Actions.addEffect'.+ -}+module Dovin.Effects+  ( effectPTSet+  , effectPTSetF+  , effectPTAdjust+  , effectPTAdjustF+  , effectNoAbilities+  , effectAddAbility+  , effectAddType++  , resolveEffects++  , enabledInPlay++  , viewSelf+  , askCards+  , askSelf+  )+  where++import Dovin.Prelude+import Dovin.Types+import Dovin.Matchers (applyMatcher, matchInPlay)++import Control.Lens (makeLenses, over, view, set)+import qualified Data.HashMap.Strict as M+import qualified Data.Set as S+import Control.Monad.Reader (ask, runReader)+import Control.Monad.State (modify')+import Data.Maybe (mapMaybe, catMaybes)+import Data.List (sortOn)++type Pile = [PileEntry]+data PileEntry = PileEntry+  { _peSource :: Card+  , _peTimestamp :: Timestamp+  , _peEffect :: [LayeredEffectPart]+  , _peAppliesTo :: [CardName]+  }+makeLenses ''PileEntry++-- | Constant variant of 'effectPTSetF'.+effectPTSet :: (Int, Int) -> LayeredEffectPart+effectPTSet = effectPTSetF . const . pure++-- | Layer 7B effect to set the power and toughness of a creature.+effectPTSetF :: (Card -> EffectMonad (Int, Int)) -> LayeredEffectPart+effectPTSetF f = LayeredEffectPart Layer7B $ \c -> do+                   pt <- f c+                   return $ set cardStrength (mkStrength pt) c++-- | Constant variant of 'effectPTAdjustF'+effectPTAdjust :: (Int, Int) -> LayeredEffectPart+effectPTAdjust = effectPTAdjustF . const . pure++-- | Layer 7C effect to adjust the power and toughness of a creature.+effectPTAdjustF :: (Card -> EffectMonad (Int, Int)) -> LayeredEffectPart+effectPTAdjustF f = LayeredEffectPart Layer7C $ \c -> do+                   pt <- f c+                   return $ over cardStrength (mkStrength pt <>) c++-- | Layer 6 effect to add an ability to a card. In practice, it adds adds a+-- new 'CardAttribute'.+effectAddAbility attr = LayeredEffectPart Layer6 (pure . over cardAttributes (S.insert attr))++-- | Layer 6 effect to remove all abilities from a card. This doesn't+-- temporary abilities added by 'addEffect'.+effectNoAbilities = LayeredEffectPart Layer6 (pure . set cardPassiveEffects mempty)++-- | Layer 4 effect to add a type to a card. Since card types are modeled+-- explicitly, it instead adds a new 'CardAttribute'.+effectAddType attr = LayeredEffectPart Layer4 (pure . over cardAttributes (S.insert attr))++-- | Effect enabled definition to apply when a card is in play.+enabledInPlay :: EffectMonad Bool+enabledInPlay = applyMatcher matchInPlay <$> askSelf++-- | The card that is generating the effect being applied.+askSelf :: EffectMonad Card+askSelf = snd <$> ask++-- | Apply a lens to 'askSelf'.+viewSelf x = view x <$> askSelf++-- | Return cards fitting the given matcher.+askCards :: CardMatcher -> EffectMonad [Card]+askCards matcher =+  filter (applyMatcher matcher)+  . M.elems+  . view resolvedCards+  . fst+  <$> ask++-- | Internal algorithm to apply re-calculate the state of the board by applying all effects.+resolveEffects :: GameMonad ()+resolveEffects = do+  -- This just happens to be a convenient place to bump the timestamp. SBE+  -- handling might be a better spot though.+  modifying currentTime (+ 1)++  modify' resetCards+  modify' resolveCounters+  modify' applyEffects++resetCards :: Board -> Board+resetCards board = set resolvedCards (M.map unwrap . view cards $ board) board+  where+    unwrap (BaseCard card) = card++-- Unlike the previous effects system, V3 attempts to better mirror the+-- layering rules while also providing a more flexible API to create more+-- types of effects. Some notable constraints this requires solving for+-- include:+--+-- * The set of cards an effect applies to needs to be fixed in the first+--   layer in which the effect would apply.+-- * Layers can create or remove effects in higher layers (e.g. removing all+--   abilities in layer 6). This means it is not possible to know all effects+--   that will be applied at the start of the algorithm, effects need to be+--   collected layer by layer.+--+-- This algorithm uses the concept of a "pile" of unapplied effects, that is+-- both added to and reduced at each layer.+--+-- 1. For every layer, all cards are checked for effects that would start+--    applying on that layer, and all parts of that effect are added to the+--    pile - alongside the set of cards to apply to. For example, "all+--    creatures are 0/1 and have no abilities" applies on both layers 6 and+--    7B and it will be added to the pile when evaluating layer 6.+-- 2. All sub-effects that apply to the current layer are removed from the+--    pile and evaluated in timestamp order. (Note: dependencies are not+--    implemented yet.)+-- 3. After the final layer, the pile should be empty.+applyEffects :: Board -> Board+applyEffects board =+  let (newBoard, pile) = foldl resolveLayer (board, mempty) allLayers in++  if null pile then+    newBoard+  else+    error "assertion failed: pile should be empty"++-- Convert card counters and legacy strength modifiers into V3 effects. Note+-- that since counter timestamps are not implemented, card timestamps are used+-- instead.+resolveCounters :: Board -> Board+resolveCounters board =+  let+    newCards = M.map countersToEffect . view resolvedCards $ board+  in++  set resolvedCards newCards board++  where+    unwrap (BaseCard card) = card++    countersToEffect :: Card -> Card+    countersToEffect card =+      let es =+            map (AbilityEffect (view cardTimestamp card) EndOfTurn . replicate 1)+            . catMaybes+            . map (\f -> f card)+            $ [ mkPTEffect . dup . view cardPlusOneCounters+              , mkPTEffect . dup . view cardMinusOneCounters+              , mkPTEffect . toTuple . view cardStrengthModifier+              ]+      in++      over+        cardAbilityEffects+        (es <>)+        card++      where+        toTuple (CardStrength p t) = (p, t)+        mkPTEffect :: (Int, Int) -> Maybe LayeredEffectPart+        mkPTEffect (p, t) =+          -- This is an optimization to not create a large number of no-op+          -- effects.+          if p == 0 && t == 0 then+            Nothing+          else+            Just $ effectPTAdjust (p, t)++        dup x = (x, x)++resolveLayer :: (Board, Pile) -> Layer -> (Board, Pile)+resolveLayer (board, pile) layer =+  let+    cs            = view resolvedCards board+    newEffects    = concatMap (extractEffects layer) cs :: Pile+    newPile       = pile <> newEffects :: Pile+    (pile', peel) = peelLayer layer newPile+    newBoard      = foldl applyEffects board . sortOn (view peTimestamp) $ peel+  in+  (newBoard, pile')++  where+    -- Take a PileEntry and apply it to the board state. It is assumed that it+    -- has already been filtered to a single layer.+    applyEffects :: Board -> PileEntry -> Board+    applyEffects board pe =+      let+        cs = mapMaybe (\cn -> M.lookup cn (view resolvedCards board))+             . view peAppliesTo+             $ pe :: [Card]+        newCards = map+                     (applyEffectParts (view peSource pe) (view peEffect pe))+                     cs+      in++      over+        resolvedCards+        (M.union . M.fromList . map (\c -> (view cardName c, c)) $ newCards)+        board++    applyEffectParts source es target =+      foldl+        (\t (LayeredEffectPart _ effect) ->+          runReader (effect t) (board, source))+        target+        es++    -- Find all effects on a card that begin applying at the given layer.+    extractEffects :: Layer -> Card -> Pile+    extractEffects layer c =+      let+        passiveEffects =+          map toPileEntry+          . view cardPassiveEffects+          $ c+        abilityEffects =+          map (\(AbilityEffect t _ es) ->+            PileEntry {+              _peSource = c,+              _peTimestamp = t,+              _peEffect = es,+              _peAppliesTo = [view cardName c]+            })+          . view cardAbilityEffects+          $ c+      in++      filter+        ((==) layer . minimum . map extractLayer . view peEffect)+        (passiveEffects <> abilityEffects)++      where+        extractLayer (LayeredEffectPart l _) = l++        toPileEntry :: LayeredEffectDefinition -> PileEntry+        toPileEntry ld =+          let+            matcher = runReader (view leAppliesTo ld) (board, c)+            cs' =+              filter+                (applyMatcher matcher)+                (M.elems . view resolvedCards $ board)+          in++          PileEntry {+            _peSource = c,+            _peTimestamp = view cardTimestamp c,+            _peEffect = view leEffect ld,+            _peAppliesTo = map (view cardName) cs'+          }++-- Return two piles, the second including every effect part that applies at+-- this layer, the first with all the remaining. Removes any entries that no+-- longer have any effect parts remaining to apply.+peelLayer :: Layer -> Pile -> (Pile, Pile)+peelLayer layer pile =+  (f not pile, f id pile)+  where+    f g =+      filter (not . null . view peEffect)+      . map (over peEffect (filter $ g . isLayer layer))++    isLayer :: Layer -> LayeredEffectPart -> Bool+    isLayer l1 (LayeredEffectPart l2 _) = l1 == l2

@@ -1,17 +1,18 @@ {-# LANGUAGE FlexibleContexts #-} module Dovin.Formatting where +import Dovin.Helpers+import Dovin.Matchers+import Dovin.Monad+import Dovin.Prelude+import Dovin.Types+ import Control.Monad.Writer (Writer, execWriter, tell)  import qualified Data.HashMap.Strict as M import qualified Data.Set as S import Data.List (intercalate, sort, sortBy, nub) import Data.Ord (comparing)--import Dovin.Helpers-import Dovin.Monad-import Dovin.Prelude-import Dovin.Types  type FormatMonad = Writer [(String, GameMonad String)] 

@@ -3,24 +3,18 @@ module Dovin.Helpers where  import Dovin.Types-import Dovin.Attributes import Dovin.Prelude+import Dovin.Matchers+import Dovin.Effects (resolveEffects)  import Data.List (sort) import qualified Data.HashMap.Strict as M import qualified Data.Set as S-import Data.Char (isDigit)-import Control.Lens (_1, _2, ASetter, both, _Just)+import Control.Lens (ASetter, _Just)+import Control.Monad.Reader (ask)  import Text.Parsec -applyMatcherWithDesc :: CardMatcher -> Card -> Either String ()-applyMatcherWithDesc (CardMatcher d f) c =-  if f c then-    Right ()-  else-    Left d- hasAttribute attr = S.member attr . view cardAttributes  manaSpec = mconcat <$> many (colorless <|> colored)@@ -40,63 +34,18 @@  requireCard :: CardName -> CardMatcher -> GameMonad Card requireCard name f = do-  maybeCard <- use $ cards . at name+  maybeCard <- use $ resolvedCards . at name    case maybeCard of     Nothing -> throwError $ "Card does not exist: " <> name-    Just card -> do-      card' <- applyEffects card-      case applyMatcherWithDesc f card' of-        Right () -> return card'+    Just card ->+      case applyMatcherWithDesc f card of+        Right () -> return card         Left msg ->           throwError $ name <> " does not match requirements: " <> msg -applyEffects :: BaseCard -> GameMonad Card-applyEffects (BaseCard card) = do-  cs <- map unwrap . M.elems <$> use cards--  let allEffects =-        concatMap-          (\c -> map (\e -> (e, c)) . view cardEffects $ c)-          cs--  let enabledEffects =-        filter-          (\(e, c) -> applyMatcher (view effectEnabled e) c)-          allEffects--  let applicableEffects =-        filter-          (\(e, c) -> applyMatcher (view effectFilter e c) card)-          enabledEffects--  card' <- foldM (\c (e, _) -> applyEffect2 c e) card applicableEffects--  let plusModifier = let n = view cardPlusOneCounters card' in-                          mkStrength (n, n)-  let minusModifier = let n = view cardMinusOneCounters card' in-                          mkStrength (-n, -n)--  let strengthModifier = view cardStrengthModifier card'--  return-    $ over-        cardStrength-        ((strengthModifier <> plusModifier <> minusModifier) <>)-        card'--  where-    applyEffect2 :: Card -> CardEffect -> GameMonad Card-    applyEffect2 card e = view effectAction e card--    unwrap :: BaseCard -> Card-    unwrap (BaseCard card) = card- allCards :: GameMonad [Card]-allCards = do-  bases <- M.elems <$> use cards--  mapM applyEffects bases+allCards = M.elems <$> use resolvedCards  modifyCardDeprecated :: CardName -> ASetter Card Card a b -> (a -> b) -> GameMonad () modifyCardDeprecated name lens f = do@@ -111,77 +60,11 @@   when (view cardPlusOneCounters card < 0) $     throwError "Cannot reduce +1/+1 counters to less than 0" +  resolveEffects+ modifyCard :: ASetter Card Card a b -> (a -> b) -> CardName -> GameMonad () modifyCard lens f name = modifyCardDeprecated name lens f --- CARD MATCHERS------ Matchers are used for both filtering sets of cards, and also for verifying--- attributes of cards.------ A wrapping type is used since I intend to add labels/introspection--- capabilities at some point.-matchDamage :: Int -> CardMatcher-matchDamage n = CardMatcher (show n <> " damage") $-  (==) n . view cardDamage--matchLoyalty :: Int -> CardMatcher-matchLoyalty n = CardMatcher (show n <> " loyalty") $-  (==) n . view cardLoyalty--matchPlusOneCounters :: Int -> CardMatcher-matchPlusOneCounters n = CardMatcher (show n <> " +1/+1 counters") $-  (==) n . view cardPlusOneCounters--matchMinusOneCounters :: Int -> CardMatcher-matchMinusOneCounters n = CardMatcher (show n <> " -1/-1 counters") $-  (==) n . view cardMinusOneCounters--matchLocation :: CardLocation -> CardMatcher-matchLocation loc = CardMatcher ("in location " <> show loc) $-  (==) loc . view cardLocation--matchInPlay = CardMatcher "in play" $ \c -> snd (view location c) == Play--matchAttribute :: CardAttribute -> CardMatcher-matchAttribute attr = CardMatcher ("has attribute " <> attr) $-  S.member attr . view cardAttributes--matchAttributes :: [CardAttribute] -> CardMatcher-matchAttributes = foldr ((<>) . matchAttribute) mempty--matchName :: CardName -> CardMatcher-matchName n = CardMatcher ("has name " <> n) $ (==) n . view cardName--matchOtherCreatures :: Card -> CardMatcher-matchOtherCreatures card = matchLocation (view cardLocation card) <> invert (matchName (view cardName card))--matchController player = CardMatcher ("has controller " <> show player) $-  (==) player . view (location . _1)--matchLesserPower n = CardMatcher ("power < " <> show n) $-  (< n) . view cardPower--matchToughness :: Int -> CardMatcher-matchToughness n = labelMatch ("toughness = " <> show n) $ (CardMatcher "" $-  (== n) . view cardToughness) <> matchAttribute creature--missingAttribute = invert . matchAttribute--(CardMatcher d1 f) `matchOr` (CardMatcher d2 g) =-    CardMatcher (d1 <> " or " <> d2) $ \c -> f c || g c--invert :: CardMatcher -> CardMatcher-invert (CardMatcher d f) = CardMatcher ("not " <> d) $ not . f--labelMatch :: String -> CardMatcher -> CardMatcher-labelMatch label (CardMatcher d f) = CardMatcher label f-applyMatcher :: CardMatcher -> Card -> Bool-applyMatcher matcher c =-  case applyMatcherWithDesc matcher c of-    Left _ -> False-    Right _ -> True- loseAttribute attr cn = do   c <- requireCard cn mempty @@ -213,3 +96,6 @@   return $ case state of              Won _ -> True              _     -> False++getTimestamp :: GameMonad Timestamp+getTimestamp = use currentTime

@@ -0,0 +1,104 @@+module Dovin.Matchers where++import Dovin.Prelude+import Dovin.Attributes (creature)+import Dovin.Types++import qualified Data.Set as S+import Control.Lens (_1)++-- CARD MATCHERS+--+-- Matchers are used for both filtering sets of cards, and also for verifying+-- attributes of cards.+matchDamage :: Int -> CardMatcher+matchDamage n = CardMatcher (show n <> " damage") $+  (==) n . view cardDamage++matchLoyalty :: Int -> CardMatcher+matchLoyalty n = CardMatcher (show n <> " loyalty") $+  (==) n . view cardLoyalty++matchPlusOneCounters :: Int -> CardMatcher+matchPlusOneCounters n = CardMatcher (show n <> " +1/+1 counters") $+  (==) n . view cardPlusOneCounters++matchMinusOneCounters :: Int -> CardMatcher+matchMinusOneCounters n = CardMatcher (show n <> " -1/-1 counters") $+  (==) n . view cardMinusOneCounters++matchLocation :: CardLocation -> CardMatcher+matchLocation loc = CardMatcher ("in location " <> show loc) $+  (==) loc . view cardLocation++matchInPlay = CardMatcher "in play" $ \c -> snd (view location c) == Play++matchAttribute :: CardAttribute -> CardMatcher+matchAttribute attr = CardMatcher ("has attribute " <> attr) $+  S.member attr . view cardAttributes++matchAttributes :: [CardAttribute] -> CardMatcher+matchAttributes = foldr ((<>) . matchAttribute) mempty++matchName :: CardName -> CardMatcher+matchName n = CardMatcher ("has name " <> n) $ (==) n . view cardName++matchOtherCreatures :: Card -> CardMatcher+matchOtherCreatures = matchOther creature++matchOther :: CardAttribute -> Card -> CardMatcher+matchOther attribute card =+     matchLocation (view cardLocation card)+  <> matchAttribute attribute+  <> invert (matchName (view cardName card))++matchController player = CardMatcher ("has controller " <> show player) $+  (==) player . view (location . _1)++matchLesserPower n = CardMatcher ("power < " <> show n) $+  (< n) . view cardPower++matchNone = CardMatcher "never match" (const False)++matchCard :: Card -> CardMatcher+matchCard = matchName . view cardName++matchToughness :: Int -> CardMatcher+matchToughness n = labelMatch ("toughness = " <> show n) $ CardMatcher ""+  ((== n) . view cardToughness) <> matchAttribute creature++matchPower :: Int -> CardMatcher+matchPower n = labelMatch ("power = " <> show n) $ CardMatcher ""+  ((== n) . view cardPower) <> matchAttribute creature++matchStrength :: (Int, Int) -> CardMatcher+matchStrength (p, t) = labelMatch ("P/T = " <> show p <> "/" <> show t) $+  matchPower p <> matchToughness t++matchTarget :: Target -> CardMatcher+matchTarget t = labelMatch ("target = " <> show t) $ CardMatcher ""+  ((==) t . TargetCard . view cardName)++missingAttribute = invert . matchAttribute++(CardMatcher d1 f) `matchOr` (CardMatcher d2 g) =+    CardMatcher (d1 <> " or " <> d2) $ \c -> f c || g c++invert :: CardMatcher -> CardMatcher+invert (CardMatcher d f) = CardMatcher ("not " <> d) $ not . f++labelMatch :: String -> CardMatcher -> CardMatcher+labelMatch label (CardMatcher d f) = CardMatcher label f++applyMatcherWithDesc :: CardMatcher -> Card -> Either String ()+applyMatcherWithDesc (CardMatcher d f) c =+  if f c then+    Right ()+  else+    Left d++applyMatcher :: CardMatcher -> Card -> Bool+applyMatcher matcher c =+  case applyMatcherWithDesc matcher c of+    Left _ -> False+    Right _ -> True

@@ -0,0 +1,42 @@+-- Top-level run function for executing and printing solutions.+module Dovin.Runner+  ( run+  ) where++import System.Exit+import Data.List (groupBy, sort, sortBy)+import Data.Ord (comparing)+import Data.Function (on)++import Dovin.Prelude+import Dovin.Monad+import Dovin.Types++run :: (Step -> Formatter) -> GameMonad () -> IO ()+run formatter solution = do+  let (e, _, log) = runMonad emptyBoard solution++  let groupedSteps =+        groupBy ((==) `on` view stepFork) . sortBy (comparing $ view stepId ) $ log++  forM_ groupedSteps $ \steps -> do+    case view stepFork $ head steps of+      Just l -> do+        putStrLn ""+        putStrLn $ "=== ALTERNATIVE: " <> l+        putStrLn ""+      Nothing -> return ()++    forM_ steps $ \step -> do+      putStr $ show (view stepNumber step) <> ". "+      putStr $ view stepLabel step+      putStrLn . formatter step . view stepState $ step++  putStrLn ""+  case e of+    Left x -> do+      putStrLn "ERROR:"+      putStrLn x+      putStrLn ""+      System.Exit.exitFailure+    Right _ -> return ()

@@ -3,10 +3,10 @@  module Dovin.Types where -import Control.Lens (Lens', Prism', makeLenses, over, view, _1, _2, _Just, at, non)-import Control.Monad.Reader (ReaderT)+import Control.Lens (Lens', makeLenses, over, view, _1, _2, at, non)+import Control.Monad.Reader (ReaderT, Reader)+import Control.Monad.Identity (runIdentity, Identity) import Control.Monad.Except (ExceptT)-import Control.Monad.Identity (Identity) import Control.Monad.State (StateT) import Control.Monad.Writer (WriterT) import qualified Data.HashMap.Strict as M@@ -14,6 +14,9 @@ import qualified Data.Set as S import GHC.Generics +data Color = Red | Green | Blue | Black | White deriving (Show, Eq, Ord)+type Colors = S.Set Color+ type CardName = String type CardAttribute = String data Player = Active | Opponent deriving (Show, Eq, Generic, Ord)@@ -24,12 +27,62 @@ data Location = Hand | Graveyard | Play | Stack | Exile | Deck   deriving (Show, Eq, Ord) +-- The original CardEffect type. This is deprecated as of V3, replaced by+-- LayeredEffect. data CardEffect = CardEffect   { _effectEnabled :: CardMatcher   , _effectFilter :: Card -> CardMatcher   , _effectAction :: Card -> GameMonad Card   } +-- A monad for writing effect definitions.+type EffectMonad a = Reader (Board, Card) a++-- These layers line up to those specified in the official rules (613).+data Layer =+    Layer1A -- ^ Copiable effects+  | Layer1B -- ^ Face down spells and permanents+  | Layer2  -- ^ Control-changing effects+  | Layer3  -- ^ Text changing effects+  | Layer4  -- ^ Type changing effects+  | Layer5  -- ^ Color changing effects+  | Layer6  -- ^ Ability changing effects+  | Layer7A -- ^ P/T from CDAs+  | Layer7B -- ^ P/T from setting+  | Layer7C -- ^ P/T adjustments (inc. counters)+  | Layer7D -- ^ P/T Switching+  | LayerOther -- ^ Other game rule affecting effects+  deriving (Show, Ord, Eq, Bounded, Enum)++allLayers :: [Layer]+allLayers = [minBound..maxBound]++-- The atomic component of an effect, that should only affect attributes at the+-- specified layer.+data LayeredEffectPart = LayeredEffectPart Layer (Card -> EffectMonad Card)++-- An effect is combined of multiple parts that each apply at different layers.+-- So called to distinguish it from the deprecated CardEffect type.+type LayeredEffect = [LayeredEffectPart]++-- An effect definition best matches up to the text describing it on a card. It+-- can generate different effects affecting different cards depending on the+-- state of the board.+data LayeredEffectDefinition = LayeredEffectDefinition+  { _leAppliesTo :: EffectMonad CardMatcher -- ^ Filter to determine which+                                            -- cards are affected by this+                                            -- effect, if enabled.+  , _leEffect :: LayeredEffect -- ^ The actions to apply to affected cards.+  , _leName :: EffectName      -- ^ A human readable description of the effect.+                               -- Optional.+  }+++mkEffect ::+  CardMatcher+  -> (Card -> CardMatcher)+  -> (Card -> Identity Card)+  -> CardEffect mkEffect enabled filter action = CardEffect   -- For an effect to be enabled, it's host card must currently match this   -- matcher.@@ -38,13 +91,20 @@   -- card is affected by it.   , _effectFilter = filter   -- The action to apply to affected cards.-  , _effectAction = action+  , _effectAction = return . runIdentity . action   } +mkLayeredEffectPart appliesTo effect name = LayeredEffectDefinition+  { _leAppliesTo = appliesTo+  , _leEffect = effect+  , _leName = name+  }+ -- A target for a spell or ability. data Target =     TargetPlayer Player -- ^ Target a player, use 'targetPlayer' to construct.   | TargetCard CardName -- ^ Target a card, use 'targetCard' to construct.+  deriving (Eq, Show)  targetPlayer = TargetPlayer targetCard = TargetCard@@ -73,9 +133,15 @@   | Won Player   deriving (Show, Eq, Ord) +type Timestamp = Integer+data EffectDuration = EndOfTurn++data AbilityEffect = AbilityEffect Timestamp EffectDuration [LayeredEffectPart]+ data Card = Card   { _cardName :: CardName   , _location :: (Player, Location)+  , _cardOwner :: Player   , _cardDefaultAttributes :: CardAttributes   , _cardAttributes :: CardAttributes   , _cardStrength :: CardStrength@@ -83,14 +149,25 @@   , _cardDamage :: Int   , _cardLoyalty :: Int   , _cardEffects :: [CardEffect]+  , _cardCmc :: Int+  , _cardColors :: Colors+  , _cardTargets :: [Target] +  , _cardTimestamp :: Timestamp+  -- These are typically set when a card is created. They can be removed by+  -- "lose all abilities" effects.+  , _cardPassiveEffects :: [LayeredEffectDefinition]+  -- These are added as the result of spells or abilities. Typically are+  -- cleared when a card changes zones(?)+  , _cardAbilityEffects :: [AbilityEffect]+   -- Can probably generalize this more at some point.   , _cardPlusOneCounters :: Int   , _cardMinusOneCounters :: Int   } instance Hashable Player instance Show Card where-  show = _cardName+  show c = _cardName c <> " " <> show (S.toList $ _cardAttributes c) instance Eq Card where   a == b = _cardName a == _cardName b @@ -101,6 +178,8 @@  data Board = Board   { _cards :: M.HashMap CardName BaseCard+  , _resolvedCards :: M.HashMap CardName Card+   -- The stack is currently the only location where we care about order, so   -- store that information alongside the main _cards map. This won't scale -   -- deck and graveyard need to be ordered also - but works for now. Need to@@ -116,12 +195,14 @@   , _manaPool :: M.HashMap Player ManaPool   , _phase :: Phase   , _currentStep :: StepIdentifier+  , _currentTime :: Timestamp   }  data Env = Env   { _envTemplate :: Card   , _envSBAEnabled :: Bool   , _envActor :: Player+  , _envOwner :: Maybe Player   }  type StepIdentifier = (Maybe String, Int)@@ -143,6 +224,7 @@ makeLenses ''CardEffect makeLenses ''Env makeLenses ''Step+makeLenses ''LayeredEffectDefinition  stepFork :: Control.Lens.Lens' Step (Maybe String) stepFork = stepId . _1@@ -159,9 +241,6 @@ cardLocation :: Control.Lens.Lens' Card (Player, Location) cardLocation = location -cardOwner :: Control.Lens.Lens' Card Player-cardOwner = cardLocation . _1- -- TODO: How to define these lenses using built-in Lens primitives -- (Control.Lens.Wrapped?) cardPower :: Control.Lens.Lens' Card Int@@ -180,6 +259,8 @@     setToughness t (CardStrength p _) = CardStrength p t     toughness (CardStrength _ t) = t +cardController :: Control.Lens.Lens' Card Player+cardController = cardLocation . _1  manaPoolFor p = manaPool . at p . non mempty @@ -209,6 +290,7 @@   { _envTemplate = emptyCard   , _envSBAEnabled = True   , _envActor = Active+  , _envOwner = Nothing   }  mkStrength (p, t) = CardStrength p t@@ -217,7 +299,9 @@   Card     { _cardName = name     , _location = location+    , _cardOwner = fst location     , _cardDefaultAttributes = mempty+    , _cardColors = mempty     , _cardAttributes = mempty     , _cardStrength = mempty     , _cardStrengthModifier = mempty@@ -226,6 +310,11 @@     , _cardEffects = mempty     , _cardPlusOneCounters = 0     , _cardMinusOneCounters = 0+    , _cardCmc = 0+    , _cardTargets = mempty+    , _cardPassiveEffects = mempty+    , _cardAbilityEffects = mempty+    , _cardTimestamp = 0     }  opposing :: Player -> Player@@ -234,6 +323,7 @@  emptyBoard = Board                { _cards = mempty+               , _resolvedCards = mempty                , _counters = mempty                , _stack = mempty                , _deck = mempty@@ -241,5 +331,6 @@                , _manaPool = mempty                , _phase = FirstMain                , _currentStep = (Nothing, 0)+               , _currentTime = 0                } 

@@ -1,30 +1,37 @@ module Dovin.V1-  ( module Dovin.Dump+  ( module Dovin.Runner   , module Dovin.Actions   , module Dovin.Attributes   , module Dovin.Builder   , module Dovin.Formatting   , module Dovin.Helpers   , module Dovin.Types+  , module Dovin.Matchers   , validate   , validateLife   , withLocation   , activate   , trigger+  , fork+  , withEffect   ) where -import Dovin.Dump+import Dovin.Runner import Dovin.Actions hiding (validate, validateLife, activate, trigger, fork) import qualified Dovin.Actions import Dovin.Attributes-import Dovin.Builder hiding (withLocation)+import Dovin.Builder hiding (withLocation, withEffect) import Dovin.Formatting import Dovin.Helpers-import Dovin.Monad import Dovin.Types+import Dovin.Matchers+import Dovin.Effects (askSelf) +import Control.Monad (forM_)+import Control.Monad.State (put, get) import Control.Monad.Reader (local) import Control.Lens (set, view)+import Control.Monad.Identity (Identity, runIdentity)  -- | Validate that a card matches a matcher. --@@ -67,3 +74,29 @@    return () +-- | Branch off to an alternate line.+fork :: [GameMonad ()] -> GameMonad ()+fork options = do+  b <- get+  let cs = view currentStep b++  forM_ options $ \m -> do+    m+    put $ set currentStep cs b++-- | Add an effect to the created card.+withEffect ::+  CardMatcher -- ^ A matcher that must apply to this card for this affect to+              -- apply. 'matchInPlay' is a typical value.+ -> (Card -> CardMatcher) -- ^ Given the current card, return a matcher that+                          -- matches cards that this affect applies to.+ -> (Card -> Identity Card) -- ^ Apply an effect to the given card.+ -> GameMonad ()+ -> GameMonad ()+withEffect applyCondition matcher action = do+  let applyConditionV3 = applyMatcher applyCondition <$> askSelf+  let matcherV3 = matcher <$> askSelf+  let actionV3 = [LayeredEffectPart LayerOther (pure . runIdentity . action)]+  let name = "legacy V2 effect"++  withEffectWhen applyConditionV3 matcherV3 actionV3 name

@@ -11,25 +11,35 @@   since it will virtually always be required for normal formatters. -} module Dovin.V2-  ( module Dovin.Dump+  ( module Dovin.Runner   , module Dovin.Actions   , module Dovin.Attributes   , module Dovin.Builder   , module Dovin.Formatting   , module Dovin.Helpers   , module Dovin.Types+  , module Dovin.Matchers   , view+  , withEffect   )   where +import Dovin.Runner import Dovin.Actions-import qualified Dovin.V1-import Dovin.Prelude-import Dovin.Dump hiding (activate, trigger, fork)+import Dovin.V1 (withEffect) import Dovin.Attributes-import Dovin.Builder+import Dovin.Builder hiding (withEffect) import Dovin.Formatting import Dovin.Helpers-import Dovin.Monad-import Dovin.Types+import Dovin.Matchers+import Dovin.Types hiding+  ( cards+  , stack+  , deck+  , life+  , manaPool+  , phase+  , currentStep+  , resolvedCards+  ) import Control.Lens (view)

@@ -0,0 +1,39 @@+{-|+V3 introduces a new effects system that is incompatible with V2 effects. V3+effects are more flexible and better align with the layer system. It also adds+some new card properties.++* `withEffect` has a new, more flexible API.+* `withEffectWhen` added as a version of `withEffect` that allows customization+   of then the effect should apply (by default they apply when card is in+   play).+* `withCMC` to set converted mana cost on cards.+* `addEffect` to apply an effect to a card. In combination with+  `effectPTAdjust` this replaces altering `cardStrengthModifier` directly,+  which is now removed.+* Added a suite of `effect*` builders for effects.+* Added `cardOwner` property to cards, and `withOwner` fluid builder to set it.+-}+module Dovin.V3+  ( module Dovin.V2+  , module Dovin.Builder+  , module Dovin.Effects+  )+  where++import Dovin.V2 hiding (withEffect, cardStrengthModifier)+import Dovin.Builder (withEffect)+import Dovin.Effects+  ( effectPTSet+  , effectPTSetF+  , effectPTAdjust+  , effectPTAdjustF+  , effectAddAbility+  , effectNoAbilities+  , effectAddType+  , enabledInPlay+  , viewSelf+  , askSelf+  , askCards+  )+

@@ -3,14 +3,12 @@ import Dovin.V2 import Dovin.Prelude -import Data.List (delete) import Control.Lens-import Debug.Trace  solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Active 1+    setLife 1      withLocation Play $ do       addLands 4 "Steam Vents"@@ -201,7 +199,7 @@      let payment = show l <> "R" -    loseLife Active l+    loseLife l     addMana $ show l      withTriggers (cast payment) "Fireball"@@ -253,7 +251,7 @@     let dmg = (life - 1) + (mana - 1)     let payment = show dmg <> "R" -    loseLife Active (life - 1)+    loseLife (life - 1)     addMana $ show (life - 1)      withTriggers (flashbackSnapped payment) "Fireball"@@ -347,7 +345,7 @@   resolve $ aetherfluxTriggerName n    x <- use spellCounter-  gainLife Active x+  gainLife x  flashbackSnapped mana castName = do   validate (matchAttribute snapped) castName

@@ -17,15 +17,15 @@     $ const $ do       trigger "Aetherflux Reservoir"       x <- use $ counters . at spellCount . non 0-      gainLife Active x+      gainLife x    cast cost name  solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 50-    setLife Active 1+    as Opponent $ setLife 50+    setLife 1      withLocation (Active, Play) $ do       addLands 3 "Spirebluff Canal"@@ -105,7 +105,7 @@    step "Activate Aetherflux Reservoir, targeting opponent" $ do     activate "" "Aetherflux Reservoir"-    loseLife Active 50+    loseLife 50     damage (const 50) (targetPlayer Opponent) "Aetherflux Reservoir"     validateLife Opponent 0 

@@ -6,7 +6,7 @@ solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 8+    as Opponent $ setLife 8     withLocation (Active, Hand) $ do       addPlaneswalker 5 "Karn, Scion of Urza 2" 

@@ -5,7 +5,7 @@ solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 3+    as Opponent $ setLife 3      withLocation Hand $ addInstant "Plummet"     withLocation Play $ do@@ -16,9 +16,10 @@         withAttributes [flying, token] $ addCreature (4, 4) "Angel"         withAttributes [flying]           $ withEffect-              matchInPlay-              (matchOtherCreatures <> (const $ matchAttribute creature))-              (pure . setAttribute hexproof)+              (matchOtherCreatures <$> askSelf)+              [ effectAddAbility hexproof+              ]+              "Other creatures gain hexproof"           $ addCreature (3, 4) "Shalai, Voice of Plenty"    step "Plummet to destroy Shalai" $ do

@@ -19,7 +19,7 @@    step "Relevant initial state" $ do     withLocation (Active, Hand) $ do-      withAttribute goblin $ addCreature (2, 2) "Legion Warboss"+      withAttributes [goblin, mentor] $ addCreature (2, 2) "Legion Warboss"       withAttribute doublestrike         $ withEffect             matchInPlay@@ -97,7 +97,8 @@   step "Attack with lazav and all goblins (haste from Garna), with mentor from Warboss" $ do     attackWith [lazav, "Legion Warboss", "Goblin 1", "Goblin 2", "Goblin 3"] -    triggerMentor "Legion Warboss" "Goblin 1"+    triggerMentor "Goblin 1" "Legion Warboss"+    resolveMentor "Goblin 1" "Legion Warboss"    step "Trigger lazav-as-isareth, reanimating Seige-Gang Commander" $ do     trigger lazav

@@ -7,10 +7,8 @@ -- http://www.possibilitystorm.com/083-guilds-of-ravnica-puzzle-1/ solution :: GameMonad () solution = do-  let mentor = "mentor"-   step "Initial state" $ do-    setLife Opponent 5+    as Opponent $ setLife 5      withLocation (Active, Hand)       $ withAttributes [flying, mentor]@@ -49,10 +47,20 @@     modifyStrength (2, 0) "Goblin Banneret"    step "Attack with everything, stacking Mentor triggers on to Aurelia" $ do-    attackWith ["Aurelia, Exemplar of Justice", "Blade Instructor", "Goblin Banneret", "Barging Sergeant"]-    triggerMentor "Blade Instructor" "Aurelia, Exemplar of Justice"-    triggerMentor "Barging Sergeant" "Aurelia, Exemplar of Justice"-    triggerMentor "Goblin Banneret" "Aurelia, Exemplar of Justice"+    attackWith+      [ "Aurelia, Exemplar of Justice"+      , "Blade Instructor"+      , "Goblin Banneret"+      , "Barging Sergeant"+      ]++    triggerMentor "Aurelia, Exemplar of Justice" "Goblin Banneret"+    triggerMentor "Aurelia, Exemplar of Justice" "Barging Sergeant"+    triggerMentor "Aurelia, Exemplar of Justice" "Blade Instructor"++    resolveMentor "Aurelia, Exemplar of Justice" "Blade Instructor"+    resolveMentor "Aurelia, Exemplar of Justice" "Barging Sergeant"+    resolveMentor "Aurelia, Exemplar of Justice" "Goblin Banneret"      combatDamage [] "Aurelia, Exemplar of Justice" 

@@ -31,7 +31,7 @@               $ addArtifact "Treasure"    step "Initial state" $ do-    setLife Opponent 9+    as Opponent $ setLife 9      withLocation (Active, Hand) $ do       withAttribute lifelink $ addCreature (1, 1) "Hunted Witness"

@@ -20,10 +20,9 @@         c <- requireCard name mempty          when (hasAttribute black c) $ do-          gainLife Active 1+          gainLife 1           trigger "Epicure of Blood"-          loseLife Opponent 1-+          as Opponent $ loseLife 1    -- Helper function to keep track of which permanent types have been cast   -- using Muldrotha's ability.@@ -45,7 +44,7 @@             assign (counters . at counterName) (Just 1)    step "Initial state" $ do-    setLife Opponent 7+    as Opponent $ setLife 7      withLocation (Active, Play) $ do       addCreature (4, 4) "Epicure of Blood"

@@ -33,7 +33,7 @@   let merfolk = "merfolk"    step "Initial state" $ do-    setLife Opponent 12+    as Opponent $ setLife 12      withLocation (Active, Hand) $ do       addSorcery "Undercity Uprising"@@ -185,7 +185,7 @@     sacrifice $ numbered 3 "Afzocan Archer"     cast "BB" "Torgaar, Famine Incarnate"     resolve "Torgaar, Famine Incarnate"-    setLife Opponent 10+    as Opponent $ setLife 10    step "Attack with Adeliz and initial archer for lethal" $ do     attackWith ["Adeliz, the Cinder Wind", "Afzocan Archer"]

@@ -5,7 +5,7 @@ solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 9+    as Opponent $ setLife 9      withLocation (Active, Hand) $ do       addCreature (1, 1) "Ochran Assassin"

@@ -6,7 +6,7 @@ solution :: GameMonad () solution = do   step "Initial Setup" $ do-    setLife Opponent 15+    as Opponent $ setLife 15      withLocation Play $ do       addLands 2 "Godless Shrine"

@@ -1,12 +1,11 @@ module Solutions.RavnicaAllegiance4 where  import Dovin.V2-import Dovin.Prelude  solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 13+    as Opponent $ setLife 13      withLocation Play $ do       addEnchantment "Rhythm of the Wild"

@@ -1,7 +1,6 @@ module Solutions.RavnicaAllegiance5 where  import Dovin.V2-import Dovin.Prelude  tapWithFreyalise mana card = do   validate matchInPlay "Song of Freyalise"@@ -16,8 +15,8 @@ solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 16-    setLife Active 17+    as Opponent $ setLife 16+    as Active $ setLife 17      withLocation Graveyard $ do       addLand "Forest"@@ -62,7 +61,7 @@   step "Use Vona to destroy Bodyguard" $ do     activate "Destroy" "" "Vona, Butcher of Magan"     tap "Vona, Butcher of Magan"-    loseLife Active 7+    loseLife 7      resolveTop @@ -92,7 +91,7 @@     trigger "Explore" "Path of Discovery" >> resolveTop     modifyCardDeprecated "Wildgrowth Walker" cardPlusOneCounters (+ 1)     trigger "Gain life" "Wildgrowth Walker" >> resolveTop-    gainLife Active 3+    gainLife 3     trigger "Untap" "Famished Paladin" >> resolveTop     untap "Famished Paladin" @@ -108,7 +107,7 @@     resolveTop     modifyCardDeprecated "Merfolk Branchwalker" cardPlusOneCounters (+ 1)     trigger "Gain life" "Wildgrowth Walker" >> resolveTop-    gainLife Active 3+    gainLife 3     trigger "Untap" "Famished Paladin" >> resolveTop     untap "Famished Paladin" @@ -117,7 +116,7 @@     resolveTop     modifyCardDeprecated "Merfolk Branchwalker" cardPlusOneCounters (+ 1)     trigger "Gain life" "Wildgrowth Walker" >> resolveTop-    gainLife Active 3+    gainLife 3     trigger "Untap" "Famished Paladin" >> resolveTop     untap "Famished Paladin" @@ -132,14 +131,14 @@     resolveTop     modifyCardDeprecated "Tenth District Veteran" cardPlusOneCounters (+ 1)     trigger "Gain life" "Wildgrowth Walker" >> resolveTop-    gainLife Active 3+    gainLife 3     trigger "Untap" "Famished Paladin" >> resolveTop     untap "Famished Paladin"    step "Use Vona to destroy Baird" $ do     activate "Destroy" "" "Vona, Butcher of Magan"     tap "Vona, Butcher of Magan"-    loseLife Active 7+    loseLife 7      resolveTop @@ -170,7 +169,7 @@      activate "Destroy" "" "Vona, Butcher of Magan"     tap "Vona, Butcher of Magan"-    loseLife Active 7+    loseLife 7      resolveTop @@ -185,7 +184,7 @@   step "Use Vona to destroy Everdawn Champion" $ do     activate "Destroy" "" "Vona, Butcher of Magan"     tap "Vona, Butcher of Magan"-    loseLife Active 7+    loseLife 7      resolveTop 

@@ -8,7 +8,7 @@ solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 18+    as Opponent $ setLife 18      withLocation Hand $ do       addAura "Deep Freeze 1"

@@ -1,16 +1,11 @@ module Solutions.RavnicaAllegiancePre2 where  import Dovin.V2-import Dovin.Prelude -import Data.List (delete)-import Control.Lens-import Debug.Trace- solution :: GameMonad () solution = do   step "Initial Setup" $ do-    setLife Opponent 7+    as Opponent $ setLife 7      withLocation Play $ do       addLands 3 "Blood Crypt"

@@ -8,7 +8,7 @@ solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 7+    as Opponent $ setLife 7      withLocation (Active, Play) $ do       addLands 2 "Mountain"@@ -23,7 +23,7 @@             (    matchLocation . view cardLocation               <> const (matchAttribute creature)             )-            (pure . over cardStrengthModifier (mkStrength (1, 1) <>))+            (pure . over cardStrength (mkStrength (1, 1) <>))         $ addCreature (2, 2) "Tah-Crop Elite"      withLocation (Active, Hand) $ do

@@ -13,7 +13,7 @@ solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 20+    as Opponent $ setLife 20      withLocation Hand $ do       addInstant "Through the Breach"

@@ -1,15 +1,13 @@ module Solutions.WarOfTheSpark2 where -import Dovin.V2-import Dovin.Prelude+import Dovin.V3  dinosaur = "dinosaur"-tricked = "tricked"  solution :: GameMonad () solution = do   step "Initial state" $ do-    setLife Opponent 4+    as Opponent $ setLife 4      withLocation Hand $ do       addAura "Kaya's Ghostform"@@ -28,17 +26,23 @@     as Opponent $ do       withLocation Play $ do         addCreature (3, 2) "Midnight Reaper"-        addCreature (1, 1) "Drover of the Mighty"+        withEffectWhen+          (do+            controller <- viewSelf cardController+            dinos <- askCards $ matchAttribute dinosaur+                             <> matchInPlay+                             <> matchController controller -        -- HACK: Model Drover's passive ability as an ability of Zetalpa. Don't-        -- currently have a way of checking _other_ cards to figure out if-        -- effect applies.-        withEffect-          matchInPlay-          (pure $ matchName "Drover of the Mighty" <> missingAttribute tricked)-          (pure . over cardStrengthModifier (mkStrength (2, 2) <>)) $-            withAttributes [indestructible] $-              addCreature (4, 8) "Zetalpa, Primal Dawn"+            return $ length dinos > 0+          )+          (matchCard <$> askSelf)+          [ effectPTAdjust (2, 2)+          ]+          "+2/+2 so long as you control another dinosaur"+            $ addCreature (1, 1) "Drover of the Mighty"++        withAttributes [indestructible, dinosaur] $+          addCreature (4, 8) "Zetalpa, Primal Dawn"         addCreature (5, 5) "God-Eternal Rhonas"    step "Cast Merfolk Trickster, targeting Drover" $ do@@ -48,7 +52,7 @@     cast "UU" "Merfolk Trickster" >> resolveTop      target "Drover of the Mighty"-    gainAttribute tricked "Drover of the Mighty"+    addEffect effectNoAbilities "Drover of the Mighty"     tap "Drover of the Mighty"    step "Cast Kaya's Ghostform on Merfolk Trickster" $ do@@ -81,7 +85,7 @@      withStateBasedActions $ do       forCards (matchInPlay <> matchAttribute creature <> invert (matchName "Massacre Girl")) $ \cn -> do-        modifyCard cardStrengthModifier (mkStrength (-1, -1) <>) cn+        addEffect (effectPTAdjust (-1, -1)) cn      validate (matchLocation (Opponent, Graveyard)) "Drover of the Mighty" @@ -92,14 +96,14 @@   step "Resolve midnight reaper damage" $ do     resolve "Self-damage" -    loseLife Opponent 1+    as Opponent $ loseLife 1    step "Resolve -1/-1, killing Midnight Reaper and Trickster" $ do     resolve "-1/-1"      withStateBasedActions $ do       forCards (matchInPlay <> matchAttribute creature <> invert (matchName "Massacre Girl")) $ \cn -> do-        modifyCard cardStrengthModifier (mkStrength (-1, -1) <>) cn+        addEffect (effectPTAdjust (-1, -1)) cn      -- Active player triggers stack first     validate (matchLocation (Active, Graveyard)) "Merfolk Trickster"@@ -115,28 +119,28 @@   step "Resolve midnight reaper damage" $ do     resolve "Self-damage" -    loseLife Opponent 1+    as Opponent $ loseLife 1    step "Resolve -1/-1 for Reaper" $ do     resolve "-1/-1 Reaper"      withStateBasedActions $ do       forCards (matchInPlay <> matchAttribute creature <> invert (matchName "Massacre Girl")) $ \cn -> do-        modifyCard cardStrengthModifier (mkStrength (-1, -1) <>) cn+        addEffect (effectPTAdjust (-1, -1)) cn    step "Resolve -1/-1 for Trickster" $ do     resolve "-1/-1 Trickster"      withStateBasedActions $ do       forCards (matchInPlay <> matchAttribute creature <> invert (matchName "Massacre Girl")) $ \cn -> do-        modifyCard cardStrengthModifier (mkStrength (-1, -1) <>) cn+        addEffect (effectPTAdjust (-1, -1)) cn    step "Return Trickster to play from Ghostform, targeting God-Eternal" $ do     moveTo Play "Merfolk Trickster"      target "God-Eternal Rhonas"     tap "God-Eternal Rhonas"-    gainAttribute tricked "God-Eternal Rhonas"+    addEffect effectNoAbilities "God-Eternal Rhonas"    step "Attack with all original creatures, opponent can only block 1 and can't kill it" $ do     attackWith ["Flux Channeler", "Rigging Runner", "Spellgorger Weird"]

@@ -0,0 +1,14 @@+module AddEffect where++import TestPrelude.V3++test_AddEffect = testGroup "addEffect"+  [ prove "adding effects changes the card in line with layer system" $ do+      withLocation Play $ do+        addCreature (1, 1) "Soldier"++      addEffect (effectPTAdjust (2, 2)) "Soldier"+      addEffect (effectPTSet (3, 3)) "Soldier"++      validate (matchStrength (5, 5)) "Soldier"+  ]

@@ -0,0 +1,136 @@+module Effects where++import TestPrelude.V3++test_Effects = testGroup "V3 effects" $+  [ testGroup "assorted cards"+    [ prove "Effects only apply when enabled" $ do+        withLocation Hand $ do+          withEffect+            (pure $ matchAttribute creature)+            [ effectPTSet (1, 1)+            ]+            "Creatures are 1/1" $ do+              addCreature (4, 4) "Some Creature"++          validate (matchStrength (4, 4)) "Some Creature"++    , prove "Sliver Legion" $ do+        let sliver = "sliver"+        withLocation Play $ do+          withAttribute sliver $+            withEffect+              (pure $ matchAttribute sliver <> matchInPlay)+              [ effectPTAdjustF . const $ do+                  self <- askSelf+                  slivers <- length <$> askCards (+                                             matchAttribute sliver+                                          <> matchInPlay+                                          <> matchOtherCreatures self)++                  return (slivers, slivers)+              ]+              "All Slivers get +1/+1 for each other Sliver"+                $ addCreature (7, 7) "Sliver Legion"++          validate (matchStrength (7, 7)) "Sliver Legion"++          withLocation Play $ do+            withAttribute sliver $ addCreature (2, 2) "Sliver 1"+            withAttribute sliver $ addCreature (2, 2) "Sliver 2"++          validate (matchStrength (9, 9)) "Sliver Legion"+          validate (matchStrength (4, 4)) "Sliver 1"++    , prove "Drover of the Mighty" $ do+        let dinosaur = "dinosaur"++        as Opponent $ do+          withLocation Play $ do+            withAttribute dinosaur $ addCreature (4, 4) "Dinosaur Op."++        withLocation Hand $ do+          withAttribute dinosaur $ addCreature (4, 4) "Dinosaur Hand"++        withLocation Play $ do+          withEffectWhen+            (do+              controller <- viewSelf cardController+              dinos <- askCards $ matchAttribute dinosaur+                               <> matchInPlay+                               <> matchController controller++              return $ length dinos > 0+            )+            (matchCard <$> askSelf)+            [ effectPTAdjust (2, 2)+            ]+            "+2/+2 so long as you control another dinosaur"+              $ addCreature (1, 1) "Drover of the Mighty"++        validate (matchStrength (1, 1)) "Drover of the Mighty"++        withLocation Play $ do+          withAttribute dinosaur $ addCreature (4, 4) "Dinosaur"++        validate (matchStrength (3, 3)) "Drover of the Mighty"+    ]+  -- https://blogs.magicjudges.org/ftw/l2-prep/rules-and-policy/continuous-effects/+  , testGroup "effects (magic judges examples)"+    [ prove "Humble & Godhead of Awe" $ do+        withLocation Play $ do+          addCreature (2, 2) "Grizzly Bear"+          withEffect+            (matchOtherCreatures <$> askSelf)+            [ effectPTSet (1, 1)+            ]+            "Other creatures are 1/1" $ do+              addCreature (4, 4) "Godhead of Awe"++          validate (matchStrength (1, 1)) "Grizzly Bear"++          addEffect (effectPTSet (0, 1)) "Godhead of Awe"+          addEffect (effectNoAbilities) "Godhead of Awe"++          validate (matchStrength (2, 2)) "Grizzly Bear"+    , prove "Humility & Opalescence" $ do+        withLocation Play $ do+          withCMC 4 $ withEffect+            (pure $ matchAttribute creature)+            [ effectPTSet (0, 1)+            , effectNoAbilities+            ]+            "Each creature loses all abilities and is 0/1" $+              addEnchantment "Humility"++          withCMC 4 $ withEffect+            (matchOther enchantment <$> askSelf)+            [ effectPTSetF (\c -> let cmc = view cardCmc c in return (cmc, cmc))+            , effectAddType creature+            ]+            "Other enchanments are creatures with P/T equal to CMC" $+              addEnchantment "Opalescence"++          validate (matchStrength (4, 4)) "Humility"++    , prove "Opalescence & Humility" $ do+        withLocation Play $ do+          withCMC 4 $ withEffect+            (matchOther enchantment <$> askSelf)+            [ effectPTSetF (\c -> let cmc = view cardCmc c in return (cmc, cmc))+            , effectAddType creature+            ]+            "Other enchanments are creatures with P/T equal to CMC" $+              addEnchantment "Opalescence"++          withCMC 4 $ withEffect+           (pure $ matchAttribute creature)+           [ effectPTSet (0, 1)+           , effectNoAbilities+           ]+           "Each creature loses all abilities and is 0/1" $+             addEnchantment "Humility"++          validate (matchStrength (0, 1)) "Humility"+    ]+  ]

@@ -0,0 +1,14 @@+module Life where++import TestPrelude.V2++test_Life = testGroup "life"+  [ prove "manipulates life total" $ do+      as Opponent $ do+        setLife 10+        validateLife 10 Opponent+        gainLife 2+        validateLife 12 Opponent+        loseLife 1+        validateLife 11 Opponent+  ]

@@ -0,0 +1,71 @@+module Mentor where++import TestPrelude.V2++test_Mentor = testGroup "mentor"+  [ prove "adds +1/+1 to target" $ do+      withLocation Play $ withAttributes [attacking, mentor] $+        addCreature (2, 2) "Legion Warboss"+      withLocation Play $ withAttributes [attacking] $+        addCreature (1, 1) "Goblin 1"++      triggerMentor "Goblin 1" "Legion Warboss"+      resolveMentor "Goblin 1" "Legion Warboss"++      c <- requireCard "Goblin 1" mempty++      unless (view cardStrength c == mkStrength (2, 2)) $+        throwError "Did not modify strength"++  , refute "requires attacking source" "has attribute attacking" $ do+      withLocation Play $ withAttributes [mentor] $+        addCreature (2, 2) "Legion Warboss"+      withLocation Play $ withAttributes [attacking] $+        addCreature (1, 1) "Goblin 1"++      triggerMentor "Goblin 1" "Legion Warboss"++  , refute "requires attacking target on trigger" "has attribute attacking" $ do+      withLocation Play $ withAttributes [mentor, attacking] $+        addCreature (2, 2) "Legion Warboss"+      withLocation Play $ withAttributes [] $+        addCreature (1, 1) "Goblin 1"++      triggerMentor "Goblin 1" "Legion Warboss"++  , refute "requires attacking target on resolution" "has attribute attacking" $ do+      withLocation Play $ withAttributes [mentor, attacking] $+        addCreature (2, 2) "Legion Warboss"+      withLocation Play $ withAttributes [attacking] $+        addCreature (1, 1) "Goblin 1"++      triggerMentor "Goblin 1" "Legion Warboss"+      loseAttribute attacking "Goblin 1"+      resolveMentor "Goblin 1" "Legion Warboss"++  , refute "requires mentor source" "has attribute mentor" $ do+      withLocation Play $ withAttributes [attacking] $+        addCreature (2, 2) "Legion Warboss"+      withLocation Play $ withAttributes [attacking] $+        addCreature (1, 1) "Goblin 1"++      triggerMentor "Goblin 1" "Legion Warboss"++  , refute "requires lesser power on trigger" "power < 1" $ do+      withLocation Play $ withAttributes [attacking, mentor] $+        addCreature (1, 2) "Legion Warboss"+      withLocation Play $ withAttributes [attacking] $+        addCreature (1, 1) "Goblin 1"++      triggerMentor "Goblin 1" "Legion Warboss"++  , refute "requires lesser power on resolution" "power < 2" $ do+      withLocation Play $ withAttributes [attacking, mentor] $+        addCreature (2, 2) "Legion Warboss"+      withLocation Play $ withAttributes [attacking] $+        addCreature (1, 1) "Goblin 1"++      triggerMentor "Goblin 1" "Legion Warboss"+      modifyStrength (1, 1) "Goblin 1"+      resolveMentor "Goblin 1" "Legion Warboss"+  ]

@@ -0,0 +1,9 @@+module TestPrelude.V3+  ( module TestPrelude.V2+  , module Dovin.V3+  ) where++import Dovin.V3+import TestPrelude.V2 hiding+  ( withEffect+  )