dovin 0.1.0.1 → 0.2

raw patch · 49 files changed

+2527/−355 lines, 49 filesdep +splitsetup-changednew-component:exe:mtgtcPVP ok

version bump matches the API change (PVP)

Dependencies added: split

API changes (from Hackage documentation)

Files

• README.md +8/−5
• Setup.hs +24/−6
• app/Main.hs +1/−0
• dovin.cabal +41/−4
• mtgtc/MTGTC.hs +753/−0
• mtgtc/Main.hs +52/−0
• src/Dovin/Actions.hs +241/−21
• src/Dovin/Attributes.hs +2/−0
• src/Dovin/Builder.hs +5/−0
• src/Dovin/Dump.hs +22/−151
• src/Dovin/Formatting.hs +7/−2
• src/Dovin/Helpers.hs +41/−8
• src/Dovin/Monad.hs +1/−1
• src/Dovin/Types.hs +39/−4
• src/Dovin/V1.hs +1/−1
• src/Dovin/V2.hs +15/−9
• src/Lib.hs +0/−6
• src/Solutions.hs +25/−10
• src/Solutions/ChannelFireball.hs +45/−45
• src/Solutions/Dominaria5.hs +2/−2
• src/Solutions/Example.hs +5/−4
• src/Solutions/GuildsOfRavnica1.hs +1/−1
• src/Solutions/GuildsOfRavnica3.hs +7/−0
• src/Solutions/GuildsOfRavnica8.hs +4/−6
• src/Solutions/GuildsOfRavnica9.hs +21/−7
• src/Solutions/GuildsOfRavnicaPre2.hs +1/−1
• src/Solutions/RavnicaAllegiance3.hs +128/−0
• src/Solutions/RavnicaAllegiance4.hs +100/−0
• src/Solutions/RavnicaAllegiance5.hs +214/−0
• src/Solutions/RavnicaAllegiance7.hs +95/−0
• src/Solutions/RavnicaAllegiancePre2.hs +149/−0
• src/Solutions/RivalsOfIxalan7.hs +14/−2
• src/Solutions/UltimateMasters.hs +19/−16
• src/Solutions/WarOfTheSpark2.hs +155/−0
• test/ActivatePlaneswalker.hs +32/−0
• test/CopySpell.hs +20/−0
• test/Destroy.hs +20/−0
• test/Driver.hs +1/−1
• test/Fight.hs +46/−0
• test/ModifyStrength.hs +39/−0
• test/Move.hs +2/−2
• test/Sacrifice.hs +20/−0
• test/Spec.hs +7/−26
• test/StateBasedActions.hs +20/−12
• test/Tap.hs +43/−0
• test/Target.hs +23/−0
• test/TargetInLocation.hs +14/−0
• test/TestPrelude.hs +1/−2
• test/TestPrelude/V2.hs +1/−0

@@ -30,7 +30,7 @@ ``` haskell module Solutions.Example where -import Dovin.V2+import Dovin  main = run formatter solution @@ -63,10 +63,11 @@       validate (matchAttribute flying) enemy       destroy enemy -formatter :: Int -> Formatter-formatter 2 = manaFormatter-  <> cardFormatter "opponent creatures" (matchLocation (Opponent, Play))-formatter _ = boardFormatter+formatter :: Step -> Formatter+formatter step = case view stepNumber step of+  1 -> manaFormatter+    <> cardFormatter "opponent creatures" (matchLocation (Opponent, Play))+  _ -> boardFormatter  manaFormatter = attributeFormatter $ do   attribute "availble mana" $@@ -112,6 +113,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!)  ## Development 

@@ -1,5 +1,5 @@ import Control.Arrow-import Control.Monad (filterM)+import Control.Monad (filterM, forM) import Data.Char import Data.List import Data.Ord@@ -25,21 +25,39 @@  writeAllSolutions :: IO () writeAllSolutions = do-  modules <- map toModuleName <$> getFilesRecursive "src/Solutions"-  let header = "module Solutions where"+  let baseDir = "src/Solutions" -  let imports = unlines . map ("import qualified " <>) $ modules+  files <- getFilesRecursive baseDir +  let header = unlines+                 [ "module Solutions where"+                 , "import Control.Lens (view)"+                 , "import Dovin.Types (stepNumber)"+                 ]++  modules <- forM files $ \filename -> do+    contents <- readFile $ baseDir </> filename++    let v2 = not $ "Dovin.V1" `isInfixOf` contents++    return (toModuleName filename, v2)++  let imports = unlines . map (("import qualified " <>) . fst) $ modules++   let array = "all = [\n  " <> (intercalate ",\n  " . map formatSolution $ modules) <> "\n  ]"    let contents = unlines [header, imports, array]   rewriteFileEx normal "src/Solutions.hs" contents    where-    formatSolution m = "("+    formatSolution (m, v2) = "("       <> show (drop (length "Solutions.") m) <> ", "       <> m <> ".solution, "-      <> m <> ".formatter)"+      <> (if v2+           then m <> ".formatter"+           else m <> ".formatter . view stepNumber")+      <> ")"  -- All these functions copy+pasted from hspec-discover getFilesRecursive :: FilePath -> IO [FilePath]

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

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 23abec652853b2a8c66c2399750bd96d11e7232610506070a3b870a252bee00d+-- hash: b16ab68c041fd8e96b59020ab905d0b6ead290ba704b581b99316cb310e5e23f  name:           dovin-version:        0.1.0.1+version:        0.2 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,7 +15,7 @@ bug-reports:    https://github.com/xaviershay/dovin/issues author:         Xavier Shay maintainer:     contact@xaviershay.com-copyright:      2018 Xavier Shay+copyright:      2019 Xavier Shay license:        BSD3 license-file:   LICENSE build-type:     Custom@@ -47,7 +47,6 @@       Dovin.Types       Dovin.V1       Dovin.V2-      Lib       Solutions       Solutions.ChannelFireball       Solutions.Core19_9@@ -59,8 +58,14 @@       Solutions.GuildsOfRavnica8       Solutions.GuildsOfRavnica9       Solutions.GuildsOfRavnicaPre2+      Solutions.RavnicaAllegiance3+      Solutions.RavnicaAllegiance4+      Solutions.RavnicaAllegiance5+      Solutions.RavnicaAllegiance7+      Solutions.RavnicaAllegiancePre2       Solutions.RivalsOfIxalan7       Solutions.UltimateMasters+      Solutions.WarOfTheSpark2   other-modules:       Paths_dovin   hs-source-dirs:@@ -72,6 +77,7 @@     , lens     , mtl     , parsec+    , split     , unordered-containers   default-language: Haskell2010 @@ -90,24 +96,54 @@     , lens     , mtl     , parsec+    , split     , 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+      CopySpell       Counter       Damage+      Destroy       Discard       Exert+      Fight       Flashback       Jumpstart+      ModifyStrength       Move       Resolve+      Sacrifice       Spec       StateBasedActions+      Tap+      Target+      TargetInLocation       TestPrelude       TestPrelude.V2       TestSolutions@@ -124,6 +160,7 @@     , lens     , mtl     , parsec+    , split     , tasty     , tasty-discover     , tasty-hunit

@@ -0,0 +1,753 @@+{-# 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

@@ -0,0 +1,52 @@+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))

@@ -10,6 +10,7 @@ -} module Dovin.Actions (   step+  , fork   -- * Casting   , cast   , castFromLocation@@ -20,17 +21,27 @@   , resolveTop   , splice   , tapForMana+  , target+  , targetInLocation   -- * Uncategorized   , activate+  , activatePlaneswalker   , attackWith   , combatDamage+  , copySpell   , damage+  , destroy   , discard   , exert+  , exile+  , fight+  , modifyStrength   , moveTo+  , sacrifice   , transitionTo   , transitionToForced   , trigger+  , with   -- * Validations   , validate   , validateCanCastSorcery@@ -132,7 +143,7 @@     (hasAttribute instant card || hasAttribute flash card)     validateCanCastSorcery -  modifyCard name (location . _2) $ const Stack+  modifyCard (location . _2) (const Stack) name    card <- requireCard name mempty @@ -286,6 +297,26 @@        assign stack xs +-- | Sacrifice a permanent.+--+-- > sacrifice "Soldier"+--+-- [Validates]+--+--   * Permanent controlled by current actor.+--   * Permanent is in play.+--+-- [Effects]+--+--   * Card is moved to graveyard. See 'move' for possible alternate effects.+sacrifice :: CardName -> GameMonad ()+sacrifice cn = do+  actor <- view envActor++  validate (matchController actor <> matchInPlay) cn++  moveTo Graveyard cn+ -- | Splices a spell on to a previously cast arcane spell. -- -- > splice "Goryo's Vengeance" "2RR" "Through the Breach"@@ -352,7 +383,7 @@ -- | Triggers an effect of a permanent. Typically you will want to `resolve` -- after triggering. ----- > activate "Draw Card" "Dawn of Hope" >> resolveTop+-- > trigger "Draw Card" "Dawn of Hope" >> resolveTop -- -- [Validates] --@@ -382,6 +413,11 @@     stack     ((:) triggerName) +-- | Helper function to provide a scoped let.+--+-- > with "Angel" $ \cn -> target cn >> destroy cn+with :: CardName -> (CardName -> GameMonad ()) -> GameMonad ()+with x f = f x  -- | Move a card from one location to another. --@@ -434,9 +470,10 @@     gainAttribute summoned name    when (snd from == Play && snd to /= Play) $ do-    modifyCard name cardPlusOneCounters (const 0)-    modifyCard name cardDamage (const 0)-    modifyCard name cardAttributes (const $ view cardDefaultAttributes c)+    modifyCard cardPlusOneCounters (const 0) name+    modifyCard cardDamage (const 0) name+    modifyCard cardAttributes (const $ view cardDefaultAttributes c) name+    modifyCard cardStrengthModifier (const mempty) name    -- These conditionals are acting on the card state _before_ any of the above   -- changes were applied.@@ -445,10 +482,34 @@       loseAttribute exileWhenLeaveStack name       moveTo Exile name   else if snd from == Play && snd to == Graveyard && view cardPlusOneCounters c == 0 && hasAttribute undying c then-    modifyCard name cardPlusOneCounters (+ 1)+    modifyCardDeprecated name cardPlusOneCounters (+ 1)   else-    modifyCard name location (const to)+    modifyCardDeprecated name location (const to) +-- | Target a permanent.+--+-- [Validates]+--+--   * Card is in play.+--   * If card belongs to opponent, does not have 'hexproof'.+target :: CardName -> GameMonad ()+target name = do+  actor <- view envActor+  card  <- requireCard name matchInPlay++  let controller = view (cardLocation . _1) card++  unless (actor == controller) $+    validate (missingAttribute hexproof) name++-- | Target a card in a non-play location.+--+-- [Validates]+--+--   * Card is in zone.+targetInLocation :: CardLocation -> CardName -> GameMonad ()+targetInLocation zone = validate (matchLocation zone)+ -- | Activate an ability of a permanent. See 'spendMana' for additional mana -- validations and effects. Typically you will want to `resolve` after -- activating.@@ -458,7 +519,7 @@ -- [Validates] -- --   * Card is in play or graveyard.---   * Card is cotrolled by actor.+--   * Card is controlled by actor. -- -- [Effects] --@@ -485,6 +546,32 @@     stack     ((:) stackName) +-- | Activate a loyalty ability of a planeswalker. Typically you will want to+-- `resolve` after activating.+--+-- > activatePlaneswalker2 "Get a card" (-1) "Karn, Scion of Urza" >> resolveTop+--+-- [Validates]+--+--   * Card is in play.+--   * Card has enough loyalty.+--+-- [Effects]+--+--   * Card loyalty is adjusted.+--+-- See `activate` for additional validations and effects.+activatePlaneswalker :: CardName -> Int -> CardName -> GameMonad ()+activatePlaneswalker stackName loyalty targetName = do+  c <- requireCard targetName matchInPlay++  if view cardLoyalty c + loyalty < 0 then+    throwError $ targetName <> " does not have enough loyalty"+  else+    do+      modifyCard cardLoyalty (+ loyalty) targetName+      activate stackName "" targetName+ -- | Start an attack with the given creatures. -- -- > attackWith ["Fanatical Firebrand"]@@ -494,6 +581,7 @@ --   * Cards are in play. --   * Cards have 'creature' attribute. --   * Cards either have 'haste' or are missing 'summoned'.+--   * Cards do not have 'defender'. -- -- [Effects] --@@ -508,6 +596,7 @@     c <- requireCard cn            (matchInPlay              <> matchAttribute "creature"+             <> missingAttribute "defender"              <> labelMatch "does not have summoning sickness" (                     matchAttribute haste                     `matchOr`@@ -588,6 +677,33 @@        return $ rem - attackPower +-- | Copy a spell on the stack, adding it to top of stack.+--+-- > copySpell "Snap Copy" "Snap"+--+-- [Validates]+--+--   * Card is on stack.+--+-- [Effects]+--+--   * New card is on top of stack.+copySpell newName targetName = do+  card <- requireCard targetName (labelMatch "on stack" $+                      matchLocation (Active, Stack)+            `matchOr` matchLocation (Opponent, Stack)+          )++  let newCard = setAttribute copy . set cardName newName $ card++  modifying+    cards+    (M.insert newName $ BaseCard newCard)++  modifying+    stack+    ((:) newName)+ -- | Applies damage from a source to a target. -- -- > damage (const 2) (targetPlayer Opponent) "Shock"@@ -612,9 +728,9 @@ --     of creatures and planeswalkers. damage ::      (Card -> Int) -- ^ A function that returns the amount of damage to apply,-                   -- given the source card.-  -> Target-  -> CardName+                   --   given the source card.+  -> Target        -- ^ Target to apply damage to+  -> CardName      -- ^ Source card   -> GameMonad () damage f t source = action "damage" $ do   c <- requireCard source mempty@@ -639,15 +755,32 @@       t <- requireCard tn $ matchInPlay <>              (matchAttribute creature `matchOr` matchAttribute planeswalker) +      target tn       when (hasAttribute creature t) $ do-        modifyCard tn cardDamage (+ dmg)+        modifyCardDeprecated tn cardDamage (+ dmg)          when (dmg > 0 && hasAttribute deathtouch c) $           gainAttribute deathtouched tn        when (hasAttribute planeswalker t) $-        modifyCard tn cardLoyalty (\x -> x - dmg)+        modifyCardDeprecated tn cardLoyalty (\x -> x - dmg) ++-- | Destroy a permanent.+--+-- [Validates]+--+--   * Card is in play.+--   * Card is not 'indestructible'+--+-- [Effects]+--+--   * Card is moved to graveyard. See 'move' for possible alternate effects.+destroy :: CardName -> GameMonad ()+destroy targetName = do+  validate (matchInPlay <> missingAttribute indestructible) targetName+  moveTo Graveyard targetName+ -- | Discard a card from the active player's hand. -- -- > discard "Mountain"@@ -673,7 +806,7 @@ -- >       (    matchLocation . view cardLocation -- >         <> const (matchAttribute creature) -- >       )--- >       (pure . over cardStrength (mkStrength (1, 1) <>))+-- >       (pure . over cardStrengthModifier (mkStrength (1, 1) <>)) -- >   $ addCreature (2, 2) "Tah-Crop Elite" -- > attackWith ["Tah-Crop Elite"] -- > exert "Tah-Crop Elite"@@ -690,6 +823,57 @@   validate (matchAttribute tapped) cn   gainAttribute exerted cn +-- | Move a card to the Exile zone.+--+-- > exile "Bridge from Below"+--+-- See `moveTo` for validations and effects.+exile :: CardName -> GameMonad ()+exile = moveTo Exile++-- | Have one card fight another (each deals damage to the other).+--+-- [Validates]+--+--   * Card is in play.+--   * Card is a creature.+--+-- [Effects]+--+--   * Each card has damage dealt to it equal to the other's power. A creature+--     fighting itself will take twice its power in damage.+--   * Note 'runStateBasedActions' handles actual destruction (if applicable)+--     of creatures.+fight :: CardName -> CardName -> GameMonad ()+fight x y = do+  validate (matchInPlay <> matchAttribute creature) x+  validate (matchInPlay <> matchAttribute creature) y++  fight' x y+  fight' y x++  where+    fight' src dst = damage (view cardPower) (targetCard dst) src++-- | Modify the strength of a card in play. It will be reset to base when the+-- card leaves play.+--+-- > modifyStrength (-2, -2) "Soldier"+--+-- [Validates]+--+--   * Card is in play.+--   * Card is a creature.+--+-- [Effects]+--+--   * Changes the strength modifier for the card.+modifyStrength :: (Int, Int) -> CardName -> GameMonad ()+modifyStrength strength cn = do+  _ <- requireCard cn (matchInPlay <> matchAttribute creature)++  modifyCard cardStrengthModifier (mkStrength strength <>) cn+ -- | Move card to location with same controller. -- -- > moveTo Graveyard "Forest"@@ -753,14 +937,23 @@ -- --   * Card is in play. --   * Card is not tapped.+--   * If creature, is not summoned or has haste. -- -- [Effects]: -- --   * Card gains tapped attribute. tap :: CardName -> GameMonad () tap name = do-  validate (matchInPlay <> missingAttribute tapped) name+  c <- requireCard name (matchInPlay <> missingAttribute tapped) +  when (applyMatcher (matchAttribute creature) c) $+    validate (labelMatch "does not have summoning sickness" (+                    matchAttribute haste+                    `matchOr`+                    missingAttribute summoned+             )) name++   gainAttribute tapped name  -- | Untaps a card.@@ -859,10 +1052,11 @@  -- | Pause running of state-based actions for the duration of the action, -- running them at the end.-withStateBasedActions :: GameMonad () -> GameMonad ()+withStateBasedActions :: GameMonad a -> GameMonad a withStateBasedActions m = do-  local (set envSBAEnabled False) m+  x <- local (set envSBAEnabled False) m   runStateBasedActions+  return x  -- | Run state-based actions. These include: --@@ -908,6 +1102,16 @@           when (hasAttribute token c) $             remove cn >> incrementCounter +        let p1 = view cardPlusOneCounters c+        let m1 = view cardMinusOneCounters c+        let p1' = maximum [0, p1 - m1]+        let m1' = maximum [0, m1 - p1]++        when (p1 /= p1' || m1 /= m1') $ do+          modifyCard cardPlusOneCounters (const p1') cn+          modifyCard cardMinusOneCounters (const m1') cn+          incrementCounter+         let matchStack =                        matchLocation (Active, Stack)              `matchOr` matchLocation (Opponent, Stack)@@ -926,14 +1130,30 @@ -- run.  'runStateBasedActions' is implicitly called at the end of each step. -- Nested 'step' invocations execute the nested action but have no other -- effects - generally they should be avoided.-step :: String -> GameMonad () -> GameMonad ()+step :: String -> GameMonad a -> GameMonad a step desc m = withStateBasedActions $ do   b <- get   let (e, b', _) = runMonad b m+  let b'' = over currentStep incrementStep b' -  tell [(desc, b')]-  put b'+  tell [mkStep (view currentStep b'') desc b'']+  put b''    case e of     Left x -> throwError x-    Right _ -> return ()+    Right y -> return y++-- | Branch off a labeled alternative line. Steps inside the fork will be+-- reported at the end of the main line output.+fork :: String -> GameMonad () -> GameMonad ()+fork label m = do+  b <- get+  modifying+    (currentStep . _1)+    (f label)+  m+  put b++  where+    f label Nothing = Just label+    f label (Just existing) = Just $ existing <> " - " <> label

@@ -28,6 +28,8 @@ deathtouch = "deathtouch" deathtouched :: CardAttribute deathtouched = "deathtouched"+defender :: CardAttribute+defender = "defender" doublestrike :: CardAttribute doublestrike = "doublestrike" enchantment :: CardAttribute

@@ -27,6 +27,7 @@   , withEffect   , withLocation   , withPlusOneCounters+  , withMinusOneCounters   ) where  import Control.Monad.Reader (ask, local)@@ -118,3 +119,7 @@ -- | Set the number of +1/+1 counters of the created card. withPlusOneCounters :: Int -> GameMonad () -> GameMonad () withPlusOneCounters = local . set (envTemplate . cardPlusOneCounters)++-- | Set the number of -1/-1 counters of the created card.+withMinusOneCounters :: Int -> GameMonad () -> GameMonad ()+withMinusOneCounters = local . set (envTemplate . cardMinusOneCounters)

@@ -9,6 +9,10 @@ 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@@ -18,94 +22,6 @@ import Dovin.Monad import Dovin.Types -whenMatch :: CardName -> CardMatcher -> GameMonad () -> GameMonad ()-whenMatch name f action = do-  match <- requireCard name f >> pure True `catchError` const (pure False)--  when match action---- ACTIONS------ These correspond to things you can do in Magic. They progress the state--- machine while verifying applicable properties. They all run inside the--- library monad.--target targetName = do-  card <- requireCard targetName (matchInPlay <> missingAttribute hexproof)--  return ()--targetInLocation zone targetName = do-  card <- requireCard targetName (matchLocation zone)--  return ()--destroy targetName = do-  _ <- requireCard targetName (matchInPlay <> missingAttribute indestructible)--  removeFromPlay targetName--sacrifice cn = do-  actor <- view envActor--  validate (matchController actor) cn--  removeFromPlay cn--removeFromPlay cardName = do-  card <- requireCard cardName matchInPlay--  moveTo Graveyard cardName--exile cardName = do-  card <- requireCard cardName mempty--  if hasAttribute "token" card then-    remove cardName-  else-    let loc = view location card in-      move loc (second (const Exile) loc) cardName--copySpell targetName newName = do-  card <- requireCard targetName mempty--  let newCard = setAttribute copy . set cardName newName $ card--  modifying-    cards-    (M.insert newName $ BaseCard newCard)--  modifying-    stack-    ((:) newName)--triggerStorm :: (Int -> GameMonad ()) -> GameMonad ()-triggerStorm action = do-  maybeStorm <- use $ counters . at "storm"--  case maybeStorm of-    Nothing -> throwError "No counter in state: storm"-    Just c -> forM [1..c-1] $ \n -> action n--  return ()--resetStrength :: CardName -> (Int, Int) -> GameMonad ()-resetStrength cn desired = do-  c <- requireCard cn (matchAttribute "creature")--  modifyCard cn cardStrength (const $ mkStrength desired)--modifyStrength :: (Int, Int) -> CardName -> GameMonad ()-modifyStrength (x, y) cn = do-  _ <- requireCard cn (matchInPlay <> matchAttribute "creature")--  modifyCard cn cardStrength (CardStrength x y <>)--  -- Fetch card again to get new strength-  c <- requireCard cn mempty--  when (view cardToughness c <= 0) $ removeFromPlay cn- -- TODO: Better name (resolveMentor?), check source has mentor attribute triggerMentor sourceName targetName = do   source <- requireCard sourceName $ matchAttribute attacking@@ -115,33 +31,6 @@    modifyStrength (1, 1) targetName --fight :: CardName -> CardName -> GameMonad ()-fight x y = do-  cx <- requireCard x (matchInPlay <> matchAttribute creature)-  cy <- requireCard y (matchInPlay <> matchAttribute creature)--  target x-  target y--  fight' cx cy-  unless (cx == cy) $ fight' cy cx--  where-    fight' cx cy = do--      let xdmg = max 0 $ view cardPower cx-      modifyCard (view cardName cy) cardDamage (+ xdmg)-      cy' <- requireCard (view cardName cy) mempty--      when (hasAttribute "lifelink" cx) $-        do-          let owner = fst . view location $ cx-          modifying (life . at owner . non 0) (+ xdmg)--      when (view cardDamage cy' >= view cardToughness cy' || (xdmg > 0 && hasAttribute "deathtouch" cx )) $-        destroy (view cardName cy)- gainLife :: Player -> Int -> GameMonad () gainLife player amount =   modifying@@ -154,50 +43,35 @@ setLife :: Player -> Int -> GameMonad () setLife p n = assign (life . at p) (Just n) -returnToHand cn = do-  actor <- view envActor-  move (actor, Graveyard) (actor, Hand) cn--returnToPlay cn = do-  actor <- view envActor-  move (actor, Graveyard) (actor, Play) cn--activatePlaneswalker :: Int -> CardName -> GameMonad ()-activatePlaneswalker loyalty cn = do-  c <- requireCard cn matchInPlay-  actor <- view envActor--  validate (matchController actor) cn--  if view cardLoyalty c - loyalty < 0 then-    throwError $ cn <> " does not have enough loyalty"-  else-    modifyCard cn cardLoyalty (+ loyalty)----- HIGH LEVEL FUNCTIONS---- fork :: [GameMonad ()] -> GameMonad () fork options = do   b <- get+  let cs = view currentStep b    forM_ options $ \m -> do     m-    put b---with x f = f x+    put $ set currentStep cs b -run :: (Int -> Formatter) -> GameMonad () -> IO ()+run :: (Step -> Formatter) -> GameMonad () -> IO () run formatter solution = do   let (e, _, log) = runMonad emptyBoard solution -  forM_ (zip log [1..]) $ \((step, board), n) -> do-    putStr $ show n <> ". "-    putStr step-    putStrLn (formatter n board)+  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@@ -206,6 +80,3 @@       putStrLn ""       System.Exit.exitFailure     Right _ -> return ()--runVerbose :: GameMonad () -> IO ()-runVerbose = run (const boardFormatter)

@@ -64,8 +64,13 @@          <> "/"          <> show (view cardToughness c)          <> (let n = view cardPlusOneCounters c in-               if n > 0 then-                  ", +" <> show n <> "/+" <> show n+              if n > 0 then+                ", +" <> show n <> "/+" <> show n+              else+                mempty)+         <> (let n = view cardMinusOneCounters c in+              if n > 0 then+                ", -" <> show n <> "/-" <> show n               else                 mempty)          <> (if view cardDamage c > 0 then

@@ -3,6 +3,7 @@ module Dovin.Helpers where  import Dovin.Types+import Dovin.Attributes import Dovin.Prelude  import Data.List (sort)@@ -71,12 +72,19 @@    card' <- foldM (\c (e, _) -> applyEffect2 c e) card applicableEffects -  let counterModifier = mconcat-                          . replicate (view cardPlusOneCounters card')-                          . mkStrength $ (1, 1)+  let plusModifier = let n = view cardPlusOneCounters card' in+                          mkStrength (n, n)+  let minusModifier = let n = view cardMinusOneCounters card' in+                          mkStrength (-n, -n) -  return $ over cardStrength (counterModifier <>) card'+  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@@ -90,12 +98,22 @@    mapM applyEffects bases -modifyCard :: CardName -> ASetter Card Card a b -> (a -> b) -> GameMonad ()-modifyCard name lens f =+modifyCardDeprecated :: CardName -> ASetter Card Card a b -> (a -> b) -> GameMonad ()+modifyCardDeprecated name lens f = do   modifying     (cards . at name . _Just)     (\(BaseCard c) -> BaseCard $ over lens f c) +  card <- requireCard name mempty++  -- This isn't a SBA, it needs to be post-condition here to make sure no funny+  -- business is happening.+  when (view cardPlusOneCounters card < 0) $+    throwError "Cannot reduce +1/+1 counters to less than 0"++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@@ -115,6 +133,10 @@ 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@@ -140,6 +162,10 @@ 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) =@@ -159,7 +185,7 @@ loseAttribute attr cn = do   c <- requireCard cn mempty -  modifyCard cn id (removeAttribute attr)+  modifyCardDeprecated cn id (removeAttribute attr)  removeAttribute :: CardAttribute -> Card -> Card removeAttribute attr = over cardAttributes (S.delete attr)@@ -167,7 +193,7 @@ gainAttribute attr cn = do   c <- requireCard cn mempty -  modifyCard cn id (setAttribute attr)+  modifyCardDeprecated cn id (setAttribute attr)  setAttribute :: CardAttribute -> Card -> Card setAttribute attr = over cardAttributes (S.insert attr)@@ -180,3 +206,10 @@    forM_ (map (view cardName) matchingCs) f +gameFinished :: GameMonad Bool+gameFinished = do+  state <- use phase++  return $ case state of+             Won _ -> True+             _     -> False

@@ -8,7 +8,7 @@  import Dovin.Types -runMonad :: Board -> GameMonad () -> (Either String (), Board, [(String, Board)])+runMonad :: Board -> GameMonad a -> (Either String a, Board, [Step]) runMonad state m =   let ((e, b), log) = runIdentity $                         runWriterT (runStateT (runReaderT (runExceptT m) emptyEnv) state) in

@@ -3,7 +3,7 @@  module Dovin.Types where -import Control.Lens (Lens', Prism', makeLenses, over, view, _1, _Just, at, non)+import Control.Lens (Lens', Prism', makeLenses, over, view, _1, _2, _Just, at, non) import Control.Monad.Reader (ReaderT) import Control.Monad.Except (ExceptT) import Control.Monad.Identity (Identity)@@ -21,7 +21,7 @@ type ManaPool = String type ManaString = String -- TODO: Stack shouldn't be in here because there is only one of them-data Location = Hand | Graveyard | Play | Stack | Exile+data Location = Hand | Graveyard | Play | Stack | Exile | Deck   deriving (Show, Eq, Ord)  data CardEffect = CardEffect@@ -70,6 +70,7 @@   | EndCombat   | SecondMain   | EndStep+  | Won Player   deriving (Show, Eq, Ord)  data Card = Card@@ -78,12 +79,14 @@   , _cardDefaultAttributes :: CardAttributes   , _cardAttributes :: CardAttributes   , _cardStrength :: CardStrength+  , _cardStrengthModifier :: CardStrength   , _cardDamage :: Int   , _cardLoyalty :: Int   , _cardEffects :: [CardEffect]    -- Can probably generalize this more at some point.   , _cardPlusOneCounters :: Int+  , _cardMinusOneCounters :: Int   } instance Hashable Player instance Show Card where@@ -103,12 +106,16 @@   -- deck and graveyard need to be ordered also - but works for now. Need to   -- think more about "hiding" this data structure.   , _stack :: [CardName]+  -- ... well I guess the deck cares about order too now hmmm. Need to figure+  -- this out.+  , _deck :: M.HashMap Player [CardName]   , _counters :: M.HashMap String Int   -- In theory, life could be just another counter. Need to think more about   -- making that happen.   , _life :: M.HashMap Player Int   , _manaPool :: M.HashMap Player ManaPool   , _phase :: Phase+  , _currentStep :: StepIdentifier   }  data Env = Env@@ -117,14 +124,38 @@   , _envActor :: Player   } -type GameMonad a = (ExceptT String (ReaderT Env (StateT Board (WriterT [(String, Board)] Identity)))) a+type StepIdentifier = (Maybe String, Int)+data Step = Step+  { _stepId :: StepIdentifier+  , _stepLabel :: String+  , _stepState :: Board+  }++type GameMonad a+   = (ExceptT String (ReaderT Env (StateT Board (WriterT [Step] Identity)))) a type Formatter = Board -> String +incrementStep :: StepIdentifier -> StepIdentifier+incrementStep (f, s) = (f, s + 1)+ makeLenses ''Board makeLenses ''Card makeLenses ''CardEffect makeLenses ''Env+makeLenses ''Step +stepFork :: Control.Lens.Lens' Step (Maybe String)+stepFork = stepId . _1++stepNumber :: Control.Lens.Lens' Step Int+stepNumber = stepId . _2++mkStep id label state = Step+  { _stepId = id+  , _stepLabel = label+  , _stepState = state+  }+ cardLocation :: Control.Lens.Lens' Card (Player, Location) cardLocation = location @@ -158,7 +189,7 @@ _manaPoolForTyping = view (manaPoolFor Active)  instance Show CardMatcher where-  show _ = "<matcher>"+  show (CardMatcher l _) = l  instance Semigroup CardMatcher where   (CardMatcher d1 f) <> (CardMatcher d2 g) =@@ -189,10 +220,12 @@     , _cardDefaultAttributes = mempty     , _cardAttributes = mempty     , _cardStrength = mempty+    , _cardStrengthModifier = mempty     , _cardDamage = 0     , _cardLoyalty = 0     , _cardEffects = mempty     , _cardPlusOneCounters = 0+    , _cardMinusOneCounters = 0     }  opposing :: Player -> Player@@ -203,8 +236,10 @@                { _cards = mempty                , _counters = mempty                , _stack = mempty+               , _deck = mempty                , _life = mempty                , _manaPool = mempty                , _phase = FirstMain+               , _currentStep = (Nothing, 0)                } 

@@ -14,7 +14,7 @@   ) where  import Dovin.Dump-import Dovin.Actions hiding (validate, validateLife, activate, trigger)+import Dovin.Actions hiding (validate, validateLife, activate, trigger, fork) import qualified Dovin.Actions import Dovin.Attributes import Dovin.Builder hiding (withLocation)

@@ -1,10 +1,15 @@--- V2 makes the following changes from V1:------   * withLocation now only takes a Location, using the current actor for---     player.---   * Flips argument order for `validate` functions to be consistent with rest---     of API.---   * `activate` and `trigger` use the stack.+{-|+V2 makes the following changes from V1:++* withLocation now only takes a Location, using the current actor for+  player.+* Flips argument order for `validate` functions to be consistent with rest+  of API.+* `activate` and `trigger` use the stack.+* Fork has a saner API and reports properly.+* `formatter` now takes a 'Step' rather than an 'Int'. 'view' is re-exported+  since it will virtually always be required for normal formatters.+-} module Dovin.V2   ( module Dovin.Dump   , module Dovin.Actions@@ -13,17 +18,18 @@   , module Dovin.Formatting   , module Dovin.Helpers   , module Dovin.Types+  , view   )   where  import Dovin.Actions import qualified Dovin.V1 import Dovin.Prelude-import Dovin.Dump hiding (activate, trigger)+import Dovin.Dump hiding (activate, trigger, fork) import Dovin.Attributes import Dovin.Builder import Dovin.Formatting import Dovin.Helpers import Dovin.Monad import Dovin.Types-import Control.Monad.Reader (local)+import Control.Lens (view)

@@ -1,6 +0,0 @@-module Lib-    ( someFunc-    ) where--someFunc :: IO ()-someFunc = putStrLn "someFunc"

@@ -1,4 +1,7 @@ module Solutions where+import Control.Lens (view)+import Dovin.Types (stepNumber)+ import qualified Solutions.ChannelFireball import qualified Solutions.Core19_9 import qualified Solutions.Dominaria5@@ -9,20 +12,32 @@ import qualified Solutions.GuildsOfRavnica8 import qualified Solutions.GuildsOfRavnica9 import qualified Solutions.GuildsOfRavnicaPre2+import qualified Solutions.RavnicaAllegiance3+import qualified Solutions.RavnicaAllegiance4+import qualified Solutions.RavnicaAllegiance5+import qualified Solutions.RavnicaAllegiance7+import qualified Solutions.RavnicaAllegiancePre2 import qualified Solutions.RivalsOfIxalan7 import qualified Solutions.UltimateMasters+import qualified Solutions.WarOfTheSpark2  all = [   ("ChannelFireball", Solutions.ChannelFireball.solution, Solutions.ChannelFireball.formatter),-  ("Core19_9", Solutions.Core19_9.solution, Solutions.Core19_9.formatter),-  ("Dominaria5", Solutions.Dominaria5.solution, Solutions.Dominaria5.formatter),+  ("Core19_9", Solutions.Core19_9.solution, Solutions.Core19_9.formatter . view stepNumber),+  ("Dominaria5", Solutions.Dominaria5.solution, Solutions.Dominaria5.formatter . view stepNumber),   ("Example", Solutions.Example.solution, Solutions.Example.formatter),-  ("ExplorersOfIxalanContest", Solutions.ExplorersOfIxalanContest.solution, Solutions.ExplorersOfIxalanContest.formatter),-  ("GuildsOfRavnica1", Solutions.GuildsOfRavnica1.solution, Solutions.GuildsOfRavnica1.formatter),-  ("GuildsOfRavnica3", Solutions.GuildsOfRavnica3.solution, Solutions.GuildsOfRavnica3.formatter),-  ("GuildsOfRavnica8", Solutions.GuildsOfRavnica8.solution, Solutions.GuildsOfRavnica8.formatter),-  ("GuildsOfRavnica9", Solutions.GuildsOfRavnica9.solution, Solutions.GuildsOfRavnica9.formatter),-  ("GuildsOfRavnicaPre2", Solutions.GuildsOfRavnicaPre2.solution, Solutions.GuildsOfRavnicaPre2.formatter),-  ("RivalsOfIxalan7", Solutions.RivalsOfIxalan7.solution, Solutions.RivalsOfIxalan7.formatter),-  ("UltimateMasters", Solutions.UltimateMasters.solution, Solutions.UltimateMasters.formatter)+  ("ExplorersOfIxalanContest", Solutions.ExplorersOfIxalanContest.solution, Solutions.ExplorersOfIxalanContest.formatter . view stepNumber),+  ("GuildsOfRavnica1", Solutions.GuildsOfRavnica1.solution, Solutions.GuildsOfRavnica1.formatter . view stepNumber),+  ("GuildsOfRavnica3", Solutions.GuildsOfRavnica3.solution, Solutions.GuildsOfRavnica3.formatter . view stepNumber),+  ("GuildsOfRavnica8", Solutions.GuildsOfRavnica8.solution, Solutions.GuildsOfRavnica8.formatter . view stepNumber),+  ("GuildsOfRavnica9", Solutions.GuildsOfRavnica9.solution, Solutions.GuildsOfRavnica9.formatter . view stepNumber),+  ("GuildsOfRavnicaPre2", Solutions.GuildsOfRavnicaPre2.solution, Solutions.GuildsOfRavnicaPre2.formatter . view stepNumber),+  ("RavnicaAllegiance3", Solutions.RavnicaAllegiance3.solution, Solutions.RavnicaAllegiance3.formatter),+  ("RavnicaAllegiance4", Solutions.RavnicaAllegiance4.solution, Solutions.RavnicaAllegiance4.formatter),+  ("RavnicaAllegiance5", Solutions.RavnicaAllegiance5.solution, Solutions.RavnicaAllegiance5.formatter),+  ("RavnicaAllegiance7", Solutions.RavnicaAllegiance7.solution, Solutions.RavnicaAllegiance7.formatter),+  ("RavnicaAllegiancePre2", Solutions.RavnicaAllegiancePre2.solution, Solutions.RavnicaAllegiancePre2.formatter),+  ("RivalsOfIxalan7", Solutions.RivalsOfIxalan7.solution, Solutions.RivalsOfIxalan7.formatter . view stepNumber),+  ("UltimateMasters", Solutions.UltimateMasters.solution, Solutions.UltimateMasters.formatter),+  ("WarOfTheSpark2", Solutions.WarOfTheSpark2.solution, Solutions.WarOfTheSpark2.formatter)   ]

@@ -73,7 +73,7 @@     withTriggers (cast "1U") "Snap"     target "Beamsplitter Mage"     trigger "Copied Snap" "Beamsplitter Mage" >> resolveTop-    copySpell "Snap" "Snap Copy (Snapcaster Mage)"+    copySpell "Snap Copy (Snapcaster Mage)" "Snap"     target "Snapcaster Mage"    step "Counter Walking Ballista with Rewind, untapping Steam Vents" $ do@@ -127,7 +127,7 @@     withTriggers (flashbackSnapped "1U") "Snap"     target "Beamsplitter Mage"     trigger "Copied Snap" "Beamsplitter Mage" >> resolveTop-    copySpell "Snap" "Snap Copy (Snapcaster Mage)"+    copySpell "Snap Copy (Snapcaster Mage)" "Snap"     target "Snapcaster Mage"    step "Resolve Snap copy, returning Snapcaster, untap Breeding Pools" $ do@@ -269,49 +269,49 @@  playExLandFormatter = cardFormatter "Play (ex. Land)"   (matchLocation (Active, Play) <> invert (matchAttribute land))-formatter 1 = attributes <> boardFormatter-formatter 3 = attributes-  <> cardFormatter "Play" (matchLocation (Active, Play))-  <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))-formatter 6 = attributes <> stackFormatter-formatter 7 = attributes <> stackFormatter-formatter 8 = attributes <> stackFormatter-  <> cardFormatter "Play" (matchLocation (Active, Play))-formatter 9 = attributes <> stackFormatter-formatter 10 = attributes <> stackFormatter-  <> cardFormatter "Hand" (matchLocation (Active, Hand))-  <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))-formatter 11 = attributes-  <> cardFormatter "Play" (matchLocation (Active, Play))-  <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))-formatter 13 = attributes <> stackFormatter-formatter 14 = attributes <> stackFormatter-  <> cardFormatter "Hand" (matchLocation (Active, Hand))-  <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))-formatter 15 = attributes <> stackFormatter-  <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))-formatter 16 = attributes-  <> cardFormatter "Hand" (matchLocation (Active, Hand))-  <> cardFormatter "Play" (matchLocation (Active, Play))-formatter 17 = attributes-  <> cardFormatter "Hand" (matchLocation (Active, Hand))-  <> playExLandFormatter-formatter 18 = attributes-  <> playExLandFormatter-  <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))-formatter 19 = attributes-  <> cardFormatter "Hand" (matchLocation (Active, Hand))-  <> playExLandFormatter-formatter 21 = attributeFormatter (attribute "opponent" $ countLife Opponent) <> attributes-formatter 22 = attributes-  <> cardFormatter "Hand" (matchLocation (Active, Hand))-  <> playExLandFormatter-  <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))-formatter 23 = attributes-  <> cardFormatter "Hand" (matchLocation (Active, Hand))-  <> playExLandFormatter-formatter 25 = attributeFormatter (attribute "opponent" $ countLife Opponent) <> attributes-formatter _ = attributes+formatter step = attributes <> case view stepNumber step of+  1 -> boardFormatter+  3 -> cardFormatter "Play" (matchLocation (Active, Play))+    <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))+  6 -> stackFormatter+  7 -> stackFormatter+  8 -> stackFormatter+    <> cardFormatter "Play" (matchLocation (Active, Play))+  9 -> stackFormatter+  10 -> stackFormatter+    <> cardFormatter "Hand" (matchLocation (Active, Hand))+    <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))+  11  ->+       cardFormatter "Play" (matchLocation (Active, Play))+    <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))+  13 -> stackFormatter+  14 -> stackFormatter+    <> cardFormatter "Hand" (matchLocation (Active, Hand))+    <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))+  15 -> stackFormatter+    <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))+  16 ->+       cardFormatter "Hand" (matchLocation (Active, Hand))+    <> cardFormatter "Play" (matchLocation (Active, Play))+  17 ->+       cardFormatter "Hand" (matchLocation (Active, Hand))+    <> playExLandFormatter+  18 ->+       playExLandFormatter+    <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))+  19 ->+       cardFormatter "Hand" (matchLocation (Active, Hand))+    <> playExLandFormatter+  21 -> attributeFormatter (attribute "opponent" $ countLife Opponent)+  22 ->+       cardFormatter "Hand" (matchLocation (Active, Hand))+    <> playExLandFormatter+    <> cardFormatter "Graveyard" (matchLocation (Active, Graveyard))+  23 ->+      cardFormatter "Hand" (matchLocation (Active, Hand))+    <> playExLandFormatter+  25 -> attributeFormatter (attribute "opponent" $ countLife Opponent)+  _ -> mempty  spellCounter :: Lens' Board Int spellCounter = counters . at "spell-count" . non 0

@@ -30,7 +30,7 @@       addCreature (5, 5) "Bonded Horncrest"    step "Activate Karn to return Mutiny" $ do-    activatePlaneswalker (-1) "Karn, Scion of Urza 1"+    activatePlaneswalker "Get card" (-1) "Karn, Scion of Urza 1" >> resolveTop     moveTo Hand "Mutiny"    step "Cast Mutiny, using Horncrest to destroy a Responder" $ do@@ -49,7 +49,7 @@     moveTo Graveyard "Karn, Scion of Urza 1"    step "Activate Karn to return Fatal Push" $ do-    activatePlaneswalker (-1) "Karn, Scion of Urza 2"+    activatePlaneswalker "Get card" (-1) "Karn, Scion of Urza 2" >> resolveTop     moveTo Hand "Fatal Push"    step "Cast Fatal Push destroying remaining Responder with Revolt from first Karn" $ do

@@ -31,10 +31,11 @@       validate (matchAttribute flying) enemy       destroy enemy -formatter :: Int -> Formatter-formatter 2 = manaFormatter-  <> cardFormatter "opponent creatures" (matchLocation (Opponent, Play))-formatter _ = boardFormatter+formatter :: Step -> Formatter+formatter step = case view stepNumber step of+  1 -> manaFormatter+    <> cardFormatter "opponent creatures" (matchLocation (Opponent, Play))+  _ -> boardFormatter  manaFormatter = attributeFormatter $ do   attribute "availble mana" $

@@ -35,7 +35,7 @@     resolve "Aurelia, Exemplar of Justice"    step "Angrath gain control, targeting Aurelia" $ do-    activatePlaneswalker (-3) "Angrath, the Flame-Chained"+    activatePlaneswalker "" (-3) "Angrath, the Flame-Chained" >> resolveTop     target "Aurelia, Exemplar of Justice"     gainAttribute "haste" "Aurelia, Exemplar of Justice" 

@@ -1,6 +1,7 @@ module Solutions.GuildsOfRavnica3 where  import Control.Monad+import Control.Monad.Except (catchError)  import Dovin.V1 @@ -139,5 +140,11 @@         combatDamage blockers "Undercity Necrolisk"         validateLife Opponent 0     ]++whenMatch :: CardName -> CardMatcher -> GameMonad () -> GameMonad ()+whenMatch name f action = do+  match <- requireCard name f >> pure True `catchError` const (pure False)++  when match action  formatter _ = boardFormatter

@@ -79,7 +79,7 @@     tapForMana "B" "Memorial to Folly 1"     withTriggers (cast "B") "March of the Drowned"     resolve "March of the Drowned"-    returnToHand "Vicious Conquistador"+    moveTo Hand "Vicious Conquistador"    step "Vicious Conquistador" $ do     tapForMana "B" "Memorial to Folly 2"@@ -92,7 +92,6 @@     target "Vicious Conquistador"     resolve "Dead Weight"     modifyStrength (-2, -2) "Vicious Conquistador"-    resetStrength "Vicious Conquistador" (1, 2)     moveTo Graveyard "Dead Weight"    step "Gruesome Menagerie for Sailor of Means and Vicious Conquistador" $ do@@ -105,8 +104,8 @@     resolve "Gruesome Menagerie"     targetInLocation (Active, Graveyard) "Vicious Conquistador"     targetInLocation (Active, Graveyard) "Sailor of Means"-    returnToPlay "Vicious Conquistador"-    returnToPlay "Sailor of Means"+    moveTo Play "Vicious Conquistador"+    moveTo Play "Sailor of Means"     withLocation (Active, Play)       $ withAttribute token       $ addArtifact "Treasure"@@ -116,7 +115,6 @@     withTriggers (castWithMuldrotha "enchantment" "B") "Dead Weight"     target "Vicious Conquistador"     modifyStrength (-2, -2) "Vicious Conquistador"-    resetStrength "Vicious Conquistador" (1, 2)     moveTo Graveyard "Dead Weight"    step "Find for Vicous Conquistador" $ do@@ -125,7 +123,7 @@     withTriggers (cast "BB") "Find"     resolve "Find"     targetInLocation (Active, Graveyard) "Vicious Conquistador"-    returnToHand "Vicious Conquistador"+    moveTo Hand "Vicious Conquistador"    step "Vicious Conquistador" $ do     tapForMana "B" "Treasure"

@@ -2,6 +2,7 @@  import Control.Lens import Control.Monad+import Control.Monad.Except (throwError)  import Dovin.V1 @@ -16,8 +17,9 @@         action name         trigger "Thousand-Year Storm"         triggerStorm $-          \n -> copySpell name+          \n -> copySpell                   (numbered (n + 1) (zipWith const name (drop 2 name)))+                  name          trigger "Adeliz, the Cinder Wind"         modifyStrength (1, 1) "Adeliz, the Cinder Wind"@@ -97,7 +99,8 @@       (gainAttribute deathtouch)      with "Shalai, Voice of Plenty" $ \enemy -> do-      fight "Adeliz, the Cinder Wind" enemy+      withStateBasedActions $+        fight "Adeliz, the Cinder Wind" enemy       validate enemy $ matchLocation (Opponent, Graveyard)    step "Cast Doublecast" $ do@@ -113,8 +116,8 @@     withTriggers (cast "G") "Plummet 1"      -- From double doublecast earlier-    copySpell "Plummet 1" "Plummet 4"-    copySpell "Plummet 1" "Plummet 5"+    copySpell "Plummet 4" "Plummet 1"+    copySpell "Plummet 5" "Plummet 1"      resolve "Plummet 5"     with "Lyra Dawnbringer" $ \enemy -> do@@ -138,7 +141,7 @@     withTriggers (cast "UU") "Quasiduplicate 1"      with ("Merfolk Mistbinder 2") $ \enemy -> do-      forM_ [1..4] $ \n -> do+      withStateBasedActions $ forM_ [1..4] $ \n -> do         let tokenName = ("Afzocan Archer " <> show n)         resolve $ numbered (5 - n) "Quasiduplicate"         addArcherCopy tokenName@@ -152,7 +155,7 @@     withTriggers (jumpstart "UU" "Waterknot") "Quasiduplicate 1"      with (numbered 1 "Merfolk Mistbinder") $ \enemy -> do-      forM_ [1..2] $ \n -> do+      withStateBasedActions $ forM_ [1..2] $ \n -> do         let tokenName = ("Afzocan Archer " <> show n)         resolve $ numbered (6 - n) "Quasiduplicate"         addArcherCopy tokenName@@ -161,7 +164,7 @@       validate enemy $ matchLocation (Opponent, Graveyard)      with "Kopala, Warden of Waves" $ \enemy -> do-      forM_ [3..4] $ \n -> do+      withStateBasedActions $ forM_ [3..4] $ \n -> do         let tokenName = numbered n "Afzocan Archer"         resolve $ numbered (6 - n) "Quasiduplicate"         addArcherCopy tokenName@@ -200,3 +203,14 @@   attribute "adeliz" $     view cardStrength <$> requireCard "Adeliz, the Cinder Wind" mempty   attribute "enemies" $ countCards (matchLocation (Opponent, Play))++triggerStorm :: (Int -> GameMonad ()) -> GameMonad ()+triggerStorm action = do+  maybeStorm <- use $ counters . at "storm"++  case maybeStorm of+    Nothing -> throwError "No counter in state: storm"+    Just c -> forM [1..c-1] $ \n -> action n++  return ()+

@@ -43,7 +43,7 @@     sacrifice "Whisper Agent"     sacrifice "Whisper, Blood Liturgist" -    returnToPlay "Torch Courier"+    moveTo Play "Torch Courier"    step "Play Rhizome Lurcher, haste with Torch Courier" $ do     tapForMana "G" "Woodland Cemetery 3"

@@ -0,0 +1,128 @@+module Solutions.RavnicaAllegiance3 where++import Dovin.V2+import Dovin.Prelude++solution :: GameMonad ()+solution = do+  step "Initial Setup" $ do+    setLife Opponent 15++    withLocation Play $ do+      addLands 2 "Godless Shrine"+      addLands 2 "Stomping Ground"+      addCreature (1, 1) "Elenda, the Dusk Rose"+      withAttribute legendary+        $ withEffect+           matchInPlay+           (matchOtherCreatures <> const (matchAttribute token))+           (pure . setAttribute vigilance . setAttribute lifelink)+        $ addCreature (2, 4) "Teysa Karlov"+      addCreature (2, 2) "Pitiless Pontiff"+      withAttribute defender $ addCreature (2, 3) "Novice Knight"+      withAttribute legendary+        $ withEffect+            matchInPlay+            matchOtherCreatures+            (pure . over cardStrength (mkStrength (1, 0) <>))+        $ addCreature (2, 2) "Judith, the Scourge Diva"++    withLocation Hand $ do+      withAttribute haste $ addCreature (3, 4) "Grand Warlord Radha"+      addInstant "Status // Statue"++    as Opponent $ do+      withLocation Play $ do+        -- Note: opponent has hexproof too! Not modeled here.+        withAttributes [flying]+          $ withEffect+              matchInPlay+              matchOtherCreatures+              (pure . setAttribute hexproof)+          $ addCreature (3, 4) "Shalai, Voice of Plenty"++        addCreature (2, 5) "Humongulus"+        addCreature (6, 6) "Rakdos, the Showstopper"++  step "Play Radha" $ do+    tapForMana "R" "Stomping Ground 1"+    tapForMana "G" "Stomping Ground 2"+    tapForMana "W" "Godless Shrine 1"+    tapForMana "W" "Godless Shrine 2"++    cast "2RW" "Grand Warlord Radha" >> resolveTop+  +  step "Attack with all except knight, generating mana" $ do+    attackWith+      [ "Judith, the Scourge Diva"+      , "Pitiless Pontiff"+      , "Teysa Karlov"+      , "Elenda, the Dusk Rose"+      , "Grand Warlord Radha"+      ]++    trigger "Generate Mana" "Grand Warlord Radha" >> resolveTop+    forCards+      (matchAttribute attacking)+      (const $ addMana "G")++  step "Status Judith to give her +1/+1 and deathtouch" $ do+    cast "G" "Status // Statue" >> resolveTop+    with "Judith, the Scourge Diva" $ \cn -> do+      gainAttribute deathtouch cn+      modifyCardDeprecated cn cardPlusOneCounters (+ 1)++  step "Sacrifice Knight to make Pontiff indestructible, ping Shalai and Rakdos with Judith" $ do+    activate "Indestructible" "1" "Pitiless Pontiff"+    sacrifice "Novice Knight"++    trigger "+1 1" "Elenda, the Dusk Rose"+    trigger "+1 2" "Elenda, the Dusk Rose"+    trigger "Judith for Elenda 1" "Judith, the Scourge Diva"+    trigger "Judith for Elenda 2" "Judith, the Scourge Diva"++    -- Need to put Shalai in the bin to remove hexproof from Rakdos+    withStateBasedActions $ do+      resolveTop+      damage (const 1) (targetCard "Shalai, Voice of Plenty") "Judith, the Scourge Diva"++    resolveTop+    damage (const 1) (targetCard "Rakdos, the Showstopper") "Judith, the Scourge Diva"++    resolveTop+    modifyCardDeprecated "Elenda, the Dusk Rose" cardPlusOneCounters (+ 1)+    resolveTop+    modifyCardDeprecated "Elenda, the Dusk Rose" cardPlusOneCounters (+ 1)++    resolve "Indestructible"+    gainAttribute indestructible "Pitiless Pontiff"+    gainAttribute deathtouch "Pitiless Pontiff"+    +  step "Apply combat damage, doesn't matter what Humongulus blocks, can't kill them" $ do+    combatDamage [] "Grand Warlord Radha"+    combatDamage [] "Judith, the Scourge Diva"+    combatDamage [] "Pitiless Pontiff"+    combatDamage [] "Teysa Karlov"+    combatDamage ["Humongulus"] "Elenda, the Dusk Rose"++  step "Sacrifice Radha, ping opponent (ignore Elenda triggers, irrelevant)" $ do+    activate "Indestructible" "1" "Pitiless Pontiff"+    sacrifice "Grand Warlord Radha"++    trigger "Judith for Elenda 1" "Judith, the Scourge Diva"+    trigger "Judith for Elenda 2" "Judith, the Scourge Diva"++    resolveTop+    damage (const 1) (targetPlayer Opponent) "Judith, the Scourge Diva"+    resolveTop+    damage (const 1) (targetPlayer Opponent) "Judith, the Scourge Diva"++    resolve "Indestructible"+    gainAttribute indestructible "Pitiless Pontiff"+    gainAttribute deathtouch "Pitiless Pontiff"++attributes = attributeFormatter $ do+  attribute "life" $ countLife Opponent+  attribute "pool" $ countManaPool Active+    +formatter _ = attributes <> boardFormatter

@@ -0,0 +1,100 @@+module Solutions.RavnicaAllegiance4 where++import Dovin.V2+import Dovin.Prelude++solution :: GameMonad ()+solution = do+  step "Initial state" $ do+    setLife Opponent 13++    withLocation Play $ do+      addEnchantment "Rhythm of the Wild"+      addCreature (2, 2) "Combine Guildmage"+      addCreature (2, 3) "Herald of Secret Streams"+      addLands 4 "Breeding Pool"+      addLands 4 "Stomping Ground"++    withLocation Hand $ do+      addCreature (2, 2) "Zhur-Taa Goblin"+      withAttribute trample $ addCreature (3, 3) "Galloping Lizrog"+      addCreature (0, 2) "Incubation Druid"++  step "Activate Guildmage for extra +1/+1 counters" $ do+    tapForMana "G" "Stomping Ground 1"+    tapForMana "G" "Stomping Ground 2"+    tap "Combine Guildmage"+    activate "Extra +1/+1" "1G" "Combine Guildmage"+    resolveTop++  step "Cast Incubation Druid with haste from riot, +1/+1 from guildmage" $ do+    tapForMana "G" "Breeding Pool 1"+    tapForMana "G" "Breeding Pool 2"+    cast "1G" "Incubation Druid" >> resolveTop++    trigger "+1/+1" "Combine Guildmage"+    trigger "Riot" "Rhythm of the Wild"++    resolve "Riot"+    gainAttribute haste "Incubation Druid"++    resolve "+1/+1"+    modifyCardDeprecated "Incubation Druid" cardPlusOneCounters (+ 1)++  step "Cast Zhur-Taa, double Riot and bonus +1/+1 for 3 total" $ do+    tapForMana "G" "Stomping Ground 3"+    tapForMana "R" "Stomping Ground 4"++    cast "RG" "Zhur-Taa Goblin" >> resolveTop++    trigger "+1/+1" "Combine Guildmage"+    trigger "Rhythm Riot" "Rhythm of the Wild"+    trigger "Zhur-Taa Riot" "Zhur-Taa Goblin"++    resolve "Zhur-Taa Riot"+    modifyCardDeprecated "Zhur-Taa Goblin" cardPlusOneCounters (+ 1)++    resolve "Rhythm Riot"+    modifyCardDeprecated "Zhur-Taa Goblin" cardPlusOneCounters (+ 1)++    resolve "+1/+1"+    modifyCardDeprecated "Zhur-Taa Goblin" cardPlusOneCounters (+ 1)++  step "Tap Druid for 3 mana, add to lands to cast Lizrog" $ do+    tap "Incubation Druid" -- TODO: Check if this checks for haste?+    activate "Mana" "" "Incubation Druid" >> resolveTop++    addMana "GGG"+    tapForMana "U" "Breeding Pool 3"+    tapForMana "U" "Breeding Pool 4"++    cast "3UG" "Galloping Lizrog" >> resolveTop+    trigger "+1/+1 swap" "Galloping Lizrog"+    trigger "+1/+1" "Combine Guildmage"+    trigger "Rhythm Riot" "Rhythm of the Wild"++    resolve "Rhythm Riot"+    gainAttribute haste "Galloping Lizrog"++    resolve "+1/+1"+    modifyCardDeprecated "Galloping Lizrog" cardPlusOneCounters (+ 1)++    resolve "+1/+1 swap"+    modifyCardDeprecated "Galloping Lizrog" cardPlusOneCounters (\x -> x - 1)+    modifyCardDeprecated "Zhur-Taa Goblin" cardPlusOneCounters (\x -> x - 3)+    modifyCardDeprecated "Incubation Druid" cardPlusOneCounters (\x -> x - 1)++    modifyCardDeprecated "Galloping Lizrog" cardPlusOneCounters (+ (5 * 2))++  step "Attacking with Lizrog, unblockable from Herald" $ do+    validate matchInPlay "Herald of Secret Streams"++    attackWith ["Galloping Lizrog"]+    combatDamage [] "Galloping Lizrog"++    validateLife 0 Opponent++attributes = attributeFormatter $ do+  attribute "life" $ countLife Opponent++formatter _ = attributes <> boardFormatter

@@ -0,0 +1,214 @@+module Solutions.RavnicaAllegiance5 where++import Dovin.V2+import Dovin.Prelude++tapWithFreyalise mana card = do+  validate matchInPlay "Song of Freyalise"+  tapForMana mana card++-- Approach:+--   * Song of Freyalise and tapping creatures for mana+--   * Use Depths to clear first creature+--   * Use Wildgrowth Walker to gain life (which untaps Famished Paladin)+--   * Use Vona x 4 to clear opponent's board+--   * Attack with all with +1/+1 from Roar and an explore for lethal+solution :: GameMonad ()+solution = do+  step "Initial state" $ do+    setLife Opponent 16+    setLife Active 17++    withLocation Graveyard $ do+      addLand "Forest"+      addLand "Swamp"++    withLocation Hand $ do+      addEnchantment "Song of Freyalise"+      addCreature (1, 3) "Wildgrowth Walker"+      addCreature (2, 1) "Merfolk Branchwalker"+      addSorcery "Enter the Unknown"+      addInstant "Rallying Roar"+      addInstant "Depths of Desire"++    withLocation Play $ do+      addEnchantment "Fall of the Thran"+      addEnchantment "Path of Discovery"+      addCreature (3, 3) "Famished Paladin"+      withAttribute vigilance $ do+        addCreature (4, 4) "Vona, Butcher of Magan"+        addCreature (2, 3) "Tenth District Veteran"+      addCreature (2, 5) "Cacophodon"+      addPlaneswalker 3 "Jace, Ingenious Mind-Mage"++    as Opponent $ do+      withLocation Play $ do+        addCreature (3, 4) "Temple Altisaur"+        addCreature (2, 2) "Everdawn Champion"+        addCreature (2, 4) "Baird, Steward of Argive"+        addCreature (2, 1) "Dauntless Bodyguard"+        addCreature (3, 5) "Imperial Ceratops"++  step "Return lands from Fall of Thran trigger" $ do+    trigger "" "Fall of the Thran" >> resolveTop+    moveTo Play "Forest"+    moveTo Play "Swamp"++  step "Cast Song of Freyalise" $ do+    tapForMana "G" "Forest"+    tapForMana "B" "Swamp"+    cast "1G" "Song of Freyalise" >> resolveTop++  step "Use Vona to destroy Bodyguard" $ do+    activate "Destroy" "" "Vona, Butcher of Magan"+    tap "Vona, Butcher of Magan"+    loseLife Active 7++    resolveTop++    target "Dauntless Bodyguard"+    destroy "Dauntless Bodyguard"++  step "Cast Depths on Altisaur using creatures" $ do+    forCards (matchController Active <> matchInPlay <> matchAttribute creature <> missingAttribute tapped <> missingAttribute summoned) (tapWithFreyalise "U")++    cast "2U" "Depths of Desire" >> resolveTop++    as Opponent $+      moveTo Hand "Temple Altisaur"+    withLocation Play $ withAttribute token $ addArtifact "Treasure"++  step "Untap with Jace" $ do+    activatePlaneswalker "" 1 "Jace, Ingenious Mind-Mage" >> resolveTop++    forCards (matchController Active <> matchInPlay <> matchAttributes [creature, tapped]) untap++  step "Cast Wildgrowth by tapping creaturs" $ do+    tapWithFreyalise "G" "Famished Paladin"+    tapWithFreyalise "G" "Tenth District Veteran"++    cast "1G" "Wildgrowth Walker" >> resolveTop++    trigger "Explore" "Path of Discovery" >> resolveTop+    modifyCardDeprecated "Wildgrowth Walker" cardPlusOneCounters (+ 1)+    trigger "Gain life" "Wildgrowth Walker" >> resolveTop+    gainLife Active 3+    trigger "Untap" "Famished Paladin" >> resolveTop+    untap "Famished Paladin"++  step "Cast Branchwalker, floating mana from paladin untaps" $ do+    tapWithFreyalise "G" "Famished Paladin"+    tapWithFreyalise "G" "Cacophodon"++    cast "1G" "Merfolk Branchwalker" >> resolveTop++    trigger "Explore Path" "Path of Discovery"+    trigger "Explore Brachwalker" "Merfolk Branchwalker"++    resolveTop+    modifyCardDeprecated "Merfolk Branchwalker" cardPlusOneCounters (+ 1)+    trigger "Gain life" "Wildgrowth Walker" >> resolveTop+    gainLife Active 3+    trigger "Untap" "Famished Paladin" >> resolveTop+    untap "Famished Paladin"++    tapWithFreyalise "G" "Famished Paladin"++    resolveTop+    modifyCardDeprecated "Merfolk Branchwalker" cardPlusOneCounters (+ 1)+    trigger "Gain life" "Wildgrowth Walker" >> resolveTop+    gainLife Active 3+    trigger "Untap" "Famished Paladin" >> resolveTop+    untap "Famished Paladin"++    tapWithFreyalise "G" "Famished Paladin"++  step "Enter the Unknown on Tenth District Veteran" $ do+    cast "G" "Enter the Unknown" >> resolveTop+    target "Tenth District Veteran"++    trigger "Explore Path" "Path of Discovery"++    resolveTop+    modifyCardDeprecated "Tenth District Veteran" cardPlusOneCounters (+ 1)+    trigger "Gain life" "Wildgrowth Walker" >> resolveTop+    gainLife Active 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++    resolveTop++    target "Baird, Steward of Argive"+    destroy "Baird, Steward of Argive"++  step "Float mana from creatures and artifact, untap with Rallying Roar" $ do+    forCards (matchController Active <> matchInPlay <> matchAttribute creature <> missingAttribute tapped <> missingAttribute summoned) (tapWithFreyalise "W")++    sacrifice "Treasure"+    addMana "1"++    cast "2W" "Rallying Roar" >> resolveTop++    forCards (matchController Active <> matchInPlay <> matchAttribute creature) (modifyStrength (1, 1))+    forCards (matchController Active <> matchInPlay <> matchAttributes [creature, tapped]) untap++  step "Attack with all" $ do+    attackWith+      [ "Famished Paladin"+      , "Tenth District Veteran"+      , "Vona, Butcher of Magan"+      , "Cacophodon"+      ]++  step "Use Vona to destroy Ceratops in response to Tenth District Veteran trigger" $ do+    trigger "Untap" "Tenth District Veteran"++    activate "Destroy" "" "Vona, Butcher of Magan"+    tap "Vona, Butcher of Magan"+    loseLife Active 7++    resolveTop++    target "Imperial Ceratops"+    destroy "Imperial Ceratops"+++  step "Resolve veteran trigger, untap Vona" $ do+    resolve "Untap"+    untap "Vona, Butcher of Magan"++  step "Use Vona to destroy Everdawn Champion" $ do+    activate "Destroy" "" "Vona, Butcher of Magan"+    tap "Vona, Butcher of Magan"+    loseLife Active 7++    resolveTop++    target "Everdawn Champion"+    destroy "Everdawn Champion"++    validateLife 1 Active++  step "Combat damage for the win" $ do+    forCards (matchAttribute attacking) (combatDamage [])+    validateLife 0 Opponent++attributes = attributeFormatter $ do+  attribute "op. life" $ countLife Opponent+  attribute "our life" $ countLife Active+  attribute "pool" $ countManaPool Active++formatter step = attributes <> case view stepNumber step of+  1  -> boardFormatter+  4  -> cardFormatter "defending" (matchInPlay <> matchController Opponent)+  5  -> cardFormatter "defending" (matchInPlay <> matchController Opponent)+  10 -> cardFormatter "defending" (matchInPlay <> matchController Opponent)+  12 -> cardFormatter "attacking" (matchAttribute attacking)+  13 -> cardFormatter "defending" (matchInPlay <> matchController Opponent)+  15 -> cardFormatter "defending" (matchInPlay <> matchController Opponent)+  _ -> mempty

@@ -0,0 +1,95 @@+module Solutions.RavnicaAllegiance7 where++import Dovin.V2+import Dovin.Prelude++unblockable = "unblockable"++solution :: GameMonad ()+solution = do+  step "Initial state" $ do+    setLife Opponent 18++    withLocation Hand $ do+      addAura "Deep Freeze 1"+      addAura "Sky Tether"+      addSorcery "Ghostform"++    withLocation Play $ do+      addLands 4 "Hallowed Fountain"+      addLands 2 "Stomping Ground"+      withAttribute trample $ addCreature (0, 8) "Erratic Cyclops"+      withAttribute defender $ addCreature (0, 4) "Suspicious Bookcase 1"+      withAttribute defender $ addCreature (0, 4) "Suspicious Bookcase 2"+      addCreature (2, 1) "Goblin Locksmith"+      withAttributes [flying, vigilance] $ addCreature (3, 5) "Arcades, the Strategist"+      addAura "Deep Freeze 2"++    as Opponent $ do+      withLocation Play $ do+        withAttributes [flying, lifelink] $ addCreature (5, 5) "Lyra Dawnbringer"+        addCreature (1, 1) "Gyre Engineer 1"+        addCreature (1, 1) "Gyre Engineer 2"+        withAttribute defender $ addCreature (0, 4) "Gyre Engineer 3"++  step "Deep Freeze opposing Lyra" $ do+    tapForMana "U" "Hallowed Fountain 1"+    tapForMana "U" "Hallowed Fountain 2"+    tapForMana "G" "Stomping Ground 1"+    cast "2U" "Deep Freeze 1" >> resolveTop++    target "Lyra Dawnbringer"+    gainAttribute defender "Lyra Dawnbringer"++  step "Sky Tether Erratic Cyclops" $ do+    tapForMana "W" "Hallowed Fountain 3"+    cast "W" "Sky Tether" >> resolveTop++    target "Erratic Cyclops"+    gainAttribute defender "Erratic Cyclops"++  step "Ghostform both bookcases" $ do+    tapForMana "U" "Hallowed Fountain 4"+    tapForMana "G" "Stomping Ground 2"++    cast "1U" "Ghostform" >> resolveTop++    forM_ [1, 2] $ \n -> do+      target $ numbered n "Suspicious Bookcase"+      gainAttribute unblockable (numbered n "Suspicious Bookcase")++  step "Attack with all, only two wizards can block Goblin and Cyclops" $ do+    -- Don't use attackWith here, because want to allow defenders to attack+    let attackers = matchInPlay <> matchAttribute creature+    forCards attackers $ \cn -> do+      tap cn+      gainAttribute attacking cn++    forCards (attackers <> matchAttribute defender) $ \cn -> do+      -- Fake Arcades effect, it shouldn't actually change their power.+      modifyCard cardStrength (\(CardStrength p t) -> CardStrength t t) cn++    -- Defenders can't block, per Goblin Locksmith+    validate (matchAttribute defender) "Gyre Engineer 3"+    validate (matchAttribute defender) "Lyra Dawnbringer"++    -- No flyers to block+    validate (matchAttribute flying) "Arcades, the Strategist"+    combatDamage [] "Arcades, the Strategist"++    -- Bookcases cannot be blocked+    validate (matchAttribute unblockable) "Suspicious Bookcase 1"+    combatDamage [] "Suspicious Bookcase 1"+    validate (matchAttribute unblockable) "Suspicious Bookcase 2"+    combatDamage [] "Suspicious Bookcase 2"++    -- Only remaining blocks+    combatDamage ["Gyre Engineer 1"] "Goblin Locksmith"+    combatDamage ["Gyre Engineer 2"] "Erratic Cyclops"++    validateLife 0 Active++attributes = attributeFormatter $ do+  attribute "life" $ countLife Opponent++formatter _ = attributes <> boardFormatter

@@ -0,0 +1,149 @@+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++    withLocation Play $ do+      addLands 3 "Blood Crypt"+      addLands 3 "Overgrown Tomb"+      withAttribute flying $ addCreature (3, 3) "Mausoleum Harpy"+      withAttribute defender $ addCreature (4, 3) "Piston-Fist Cyclops"+      withAttribute defender $ addCreature (0, 2) "Dragon Egg"+      addEnchantment "Rhythm of the Wild 1"+      addEnchantment "Rhythm of the Wild 2"++    withLocation Hand $ do+      addInstant "Ancient Animus"+      addCreature (2, 2) "Growth-Chamber Guardian 1"++    withLocation Deck $ do+      addCreature (2, 2) "Growth-Chamber Guardian 2"++    as Opponent $ do+      withLocation Play $ do+        withAttribute doublestrike $ addCreature (3, 3) "Goring Ceratops"+        withAttribute firststrike $ addCreature (3, 3) "Goblin Chainwhirler 1"+        withAttribute firststrike $ addCreature (3, 3) "Goblin Chainwhirler 2"++  step "Cast Guardian, get haste/+1 from Rhythm triggers" $ do+    tapForMana "G" "Overgrown Tomb 1"+    tapForMana "R" "Blood Crypt 1"+    cast "1G" "Growth-Chamber Guardian 1" >> resolveTop++    trigger "Haste" "Rhythm of the Wild 1"+    trigger "+1/+1" "Rhythm of the Wild 2"+    resolveTop+    modifyCardDeprecated "Growth-Chamber Guardian 1" cardPlusOneCounters (+ 1)+    trigger "Search" "Growth-Chamber Guardian 1"++    resolveTop+    move (Active, Deck) (Active, Hand) "Growth-Chamber Guardian 2"++    resolveTop+    gainAttribute haste "Growth-Chamber Guardian 1"++  step "Cast second Guardian, same haste/+1 combo (decline search)" $ do+    tapForMana "G" "Overgrown Tomb 2"+    tapForMana "R" "Blood Crypt 2"+    cast "1G" "Growth-Chamber Guardian 2" >> resolveTop++    trigger "Haste" "Rhythm of the Wild 1"+    trigger "+1/+1" "Rhythm of the Wild 2"+    resolveTop+    modifyCardDeprecated "Growth-Chamber Guardian 2" cardPlusOneCounters (+ 1)+    trigger "Search" "Growth-Chamber Guardian 1"+    resolveTop++    resolveTop+    gainAttribute haste "Growth-Chamber Guardian 2"++  step "Cast Animus on Egg. Enables Piston-Fist, triggers Harpy" $ do+    tapForMana "G" "Overgrown Tomb 3"+    tapForMana "R" "Blood Crypt 3"+    cast "1G" "Ancient Animus" >> resolveTop+    target "Dragon Egg"++    loseAttribute defender "Piston-Fist Cyclops"++    fight "Dragon Egg" "Goring Ceratops"+    trigger "Make Dragon" "Dragon Egg"+    trigger "+1/+1" "Mausoleum Harpy"++    resolveHarpyTrigger++    resolveTop+    withLocation Play $ do+      withAttributes [token, flying, summoned] $ addCreature (2, 2) "Dragon"++  step "Attack with all except dragon" $ do+    attackWith+      [ "Mausoleum Harpy"+      , "Piston-Fist Cyclops"+      , "Growth-Chamber Guardian 1"+      , "Growth-Chamber Guardian 2"+      ]++  fork "Opponent doesn't block one ground attacker, damage is lethal" $ do+    step "First-strike damage" $ do+      combatDamage ["Goring Ceratops"] "Piston-Fist Cyclops"+      combatDamage ["Goblin Chainwhirler 1"] "Growth-Chamber Guardian 1"++    step "Death triggers for harpy" $ do+      trigger "Cyclops" "Mausoleum Harpy"+      trigger "Guardian 1" "Mausoleum Harpy"++      resolveTop >> modifyStrength (1, 1) "Mausoleum Harpy"+      resolveTop >> modifyStrength (1, 1) "Mausoleum Harpy"++    step "Regular damage" $ do+      combatDamage [] "Mausoleum Harpy"+      combatDamage [] "Growth-Chamber Guardian 2"+      validateLife (-2) Opponent++  step "First-strike damage" $ do+    combatDamage ["Goring Ceratops"] "Piston-Fist Cyclops"+    combatDamage ["Goblin Chainwhirler 1"] "Growth-Chamber Guardian 1"+    combatDamage ["Goblin Chainwhirler 2"] "Growth-Chamber Guardian 2"++  step "Death triggers for harpy" $ do+    trigger "Cyclops" "Mausoleum Harpy"+    trigger "Guardian 1" "Mausoleum Harpy"+    trigger "Guardian 2" "Mausoleum Harpy"++    resolveTop >> modifyStrength (1, 1) "Mausoleum Harpy"+    resolveTop >> modifyStrength (1, 1) "Mausoleum Harpy"+    resolveTop >> modifyStrength (1, 1) "Mausoleum Harpy"++  step "Regular damage" $ do+    combatDamage [] "Mausoleum Harpy"+    validateLife 0 Opponent++formatter step = attributes <> case view stepNumber step of+  1 -> boardFormatter+  5 -> cardFormatter+        "attacking creatures"+        (matchLocation (Active, Play)+        <> matchAttribute attacking+        )+  _ -> mempty++resolveHarpyTrigger = do+  resolveTop+  modifyCardDeprecated "Mausoleum Harpy" cardPlusOneCounters (+ 1)++attributes = attributeFormatter $ do+  attribute "life" $ countLife Opponent+  attribute "mana" $ countCards $ matchAttribute land <> missingAttribute tapped+  attribute "harpy" $+    view cardStrength <$> requireCard "Mausoleum Harpy" mempty++blocked = "blocked"

@@ -23,7 +23,7 @@             (    matchLocation . view cardLocation               <> const (matchAttribute creature)             )-            (pure . over cardStrength (mkStrength (1, 1) <>))+            (pure . over cardStrengthModifier (mkStrength (1, 1) <>))         $ addCreature (2, 2) "Tah-Crop Elite"      withLocation (Active, Hand) $ do@@ -64,7 +64,7 @@     trigger "Tilonalli's Skinshifter"     target "Tah-Crop Elite"     validate "Tah-Crop Elite" $ matchAttribute attacking-    resetStrength "Tilonalli's Skinshifter" (2, 2)+    copyAttributes "Tah-Crop Elite" "Tilonalli's Skinshifter"     gainAttribute flying "Tilonalli's Skinshifter"    fork@@ -132,3 +132,15 @@     <> (missingAttribute blocked `matchOr` matchAttribute trample)     ) formatter _ = attributes++copyAttributes :: CardName -> CardName -> GameMonad ()+copyAttributes from to = do+  toCard <- requireCard to (matchAttribute creature)++  -- Can't use requireCard because need access to the base strength+  maybeCard <- use $ cards . at from++  case maybeCard of+    Nothing -> throwError $ "Card does not exist: " <> from+    Just (BaseCard card) -> do+      modifyCard cardStrength (const $ view cardStrength card) to

@@ -1,6 +1,6 @@ module Solutions.UltimateMasters where -import Control.Lens (over)+import Control.Lens (over, view) import Control.Monad  import Dovin.V2@@ -64,7 +64,7 @@      cast "B" "Reanimate" >> resolveTop     targetInLocation (Active, Graveyard) "Vengevine"-    returnToPlay "Vengevine"+    moveTo Play "Vengevine"    step "Sac Vengevine (undying) then Mikaeus for mana" $ do     sacrificeToAltar "U" "Vengevine"@@ -89,7 +89,7 @@     with "Mikaeus, the Unhallowed" $ \cn -> do       targetInLocation (Active, Graveyard) cn       validate (matchAttribute legendary) cn-      returnToPlay cn+      moveTo Play cn       gainAttribute haste cn      with "Stingerfling Spider" $ \cn -> do@@ -103,7 +103,7 @@       destroy "Sublime Archangel"    step "Liliana to force sac of Reya" $ do-    activatePlaneswalker 1 "Liliana of the Veil"+    activatePlaneswalker "" 1 "Liliana of the Veil" >> resolveTop     as Opponent $ do       sacrifice "Reya Dawnbringer" @@ -169,7 +169,7 @@     cast "4GR" "Vengeful Rebirth" >> resolveTop      targetInLocation (Active, Graveyard) "Mikaeus, the Unhallowed"-    returnToHand "Mikaeus, the Unhallowed"+    moveTo Hand "Mikaeus, the Unhallowed"     damage (const 6) (targetPlayer Opponent) "Vengeful Rebirth"      validateLife 0 Opponent@@ -181,44 +181,47 @@             <> matchController Active             )       <*> countManaPool Active-formatter 1 = boardFormatter-formatter 3 = manaAttribute++formatter = oldFormatter . view stepNumber++oldFormatter 1 = boardFormatter+oldFormatter 3 = manaAttribute   <> cardFormatter        "creatures"        (matchLocation (Active, Play) <> matchAttribute creature)   <> cardFormatter        "graveyard"        (matchLocation (Active, Graveyard) <> matchAttribute creature)-formatter 4 = manaAttribute+oldFormatter 4 = manaAttribute   <> cardFormatter        "remaining creatures"        (matchLocation (Opponent, Play) <> matchAttribute creature)-formatter 5 = manaAttribute+oldFormatter 5 = manaAttribute   <> cardFormatter        "remaining creatures"        (matchLocation (Opponent, Play) <> matchAttribute creature)-formatter 6 = manaAttribute+oldFormatter 6 = manaAttribute   <> cardFormatter        "remaining creatures"        (matchLocation (Opponent, Play) <> matchAttribute creature)-formatter 8 =+oldFormatter 8 =   cardFormatter     "creatures"     (matchLocation (Active, Play) <> matchAttribute creature)-formatter 9 =+oldFormatter 9 =   cardFormatter     "unblocked creatures"     (matchLocation (Active, Play)     <> matchAttribute creature     <> invert (matchAttribute "blocked")     )-formatter 10 =+oldFormatter 10 =      attributeFormatter (attribute "life" (countLife Opponent))   <> cardFormatter        "creatures"        (matchLocation (Active, Play) <> matchAttribute creature)-formatter 11 = manaAttribute+oldFormatter 11 = manaAttribute   <> attributeFormatter (attribute "life" (countLife Opponent))-formatter 12 = manaAttribute+oldFormatter 12 = manaAttribute   <> attributeFormatter (attribute "life" (countLife Opponent))-formatter _ = manaAttribute+oldFormatter _ = manaAttribute

@@ -0,0 +1,155 @@+module Solutions.WarOfTheSpark2 where++import Dovin.V2+import Dovin.Prelude++dinosaur = "dinosaur"+tricked = "tricked"++solution :: GameMonad ()+solution = do+  step "Initial state" $ do+    setLife Opponent 4++    withLocation Hand $ do+      addAura "Kaya's Ghostform"+      withAttribute haste $ addCreature (1, 1) "Dreadhorde Butcher"+      addCreature (2, 2) "Merfolk Trickster"+      addCreature (4, 4) "Massacre Girl"++    withLocation Play $ do+      addLands 4 "Steam Vents"+      addLands 4 "Blood Crypt"++      withPlusOneCounters 2 $ addCreature (2, 2) "Flux Channeler"+      withPlusOneCounters 3 $ withAttribute firststrike $ addCreature (1, 1) "Rigging Runner"+      withPlusOneCounters 1 $ addCreature (2, 2) "Spellgorger Weird"++    as Opponent $ do+      withLocation Play $ do+        addCreature (3, 2) "Midnight Reaper"+        addCreature (1, 1) "Drover of the Mighty"++        -- 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"+        addCreature (5, 5) "God-Eternal Rhonas"++  step "Cast Merfolk Trickster, targeting Drover" $ do+    tapForMana "U" "Steam Vents 1"+    tapForMana "U" "Steam Vents 2"++    cast "UU" "Merfolk Trickster" >> resolveTop++    target "Drover of the Mighty"+    gainAttribute tricked "Drover of the Mighty"+    tap "Drover of the Mighty"++  step "Cast Kaya's Ghostform on Merfolk Trickster" $ do+    tapForMana "B" "Blood Crypt 1"++    cast "B" "Kaya's Ghostform"+    target "Merfolk Trickster"++    trigger "Proliferate" "Flux Channeler"+    trigger "+1/+1" "Spellgorger Weird"++    resolve "+1/+1"+    modifyCard cardPlusOneCounters (+ 1) "Spellgorger Weird"++    resolve "Proliferate"+    modifyCard cardPlusOneCounters (+ 1) "Spellgorger Weird"+    modifyCard cardPlusOneCounters (+ 1) "Rigging Runner"+    modifyCard cardPlusOneCounters (+ 1) "Flux Channeler"++    resolve "Kaya's Ghostform"++  step "Cast Massacre Girl, killing Drover" $ do+    tapForMana "B" "Blood Crypt 2"+    tapForMana "B" "Blood Crypt 3"+    tapForMana "B" "Blood Crypt 4"+    tapForMana "U" "Steam Vents 3"+    tapForMana "U" "Steam Vents 4"++    cast "3BB" "Massacre Girl" >> resolveTop++    withStateBasedActions $ do+      forCards (matchInPlay <> matchAttribute creature <> invert (matchName "Massacre Girl")) $ \cn -> do+        modifyCard cardStrengthModifier (mkStrength (-1, -1) <>) cn++    validate (matchLocation (Opponent, Graveyard)) "Drover of the Mighty"++    trigger "-1/-1" "Massacre Girl"+    as Opponent $ do+      trigger "Self-damage" "Midnight Reaper"++  step "Resolve midnight reaper damage" $ do+    resolve "Self-damage"++    loseLife Opponent 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++    -- Active player triggers stack first+    validate (matchLocation (Active, Graveyard)) "Merfolk Trickster"+    validate (matchLocation (Opponent, Graveyard)) "Midnight Reaper"+    moveTo Graveyard "Kaya's Ghostform"++    trigger "Return Trickster" "Kaya's Ghostform"+    trigger "-1/-1 Trickster" "Massacre Girl"+    trigger "-1/-1 Reaper" "Massacre Girl"+    as Opponent $ do+      trigger "Self-damage" "Midnight Reaper"++  step "Resolve midnight reaper damage" $ do+    resolve "Self-damage"++    loseLife Opponent 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++  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++  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"++  step "Attack with all original creatures, opponent can only block 1 and can't kill it" $ do+    attackWith ["Flux Channeler", "Rigging Runner", "Spellgorger Weird"]++    -- First strike damage+    combatDamage ["Zetalpa, Primal Dawn"] "Rigging Runner"++    -- Regular damage+    combatDamage [] "Flux Channeler"+    combatDamage [] "Spellgorger Weird"++    validateLife 0 Opponent++attributes = attributeFormatter $ do+  attribute "life" $ countLife Opponent+formatter _ = attributes <> boardFormatter

@@ -0,0 +1,32 @@+module ActivatePlaneswalker where++import TestPrelude.V2++test_ActivatePlaneswalker = testGroup "activatePlaneswalker"+  [ prove "adds activated card to stack" $ do+      withLocation Play $ addPlaneswalker 4 "Karn, Scion of Urza"+      activatePlaneswalker "Reveal cards" (-1) "Karn, Scion of Urza"++      validate+        (matchLocation (Active, Stack) <> matchAttribute activated)+        "Reveal cards"+      validate (matchLoyalty 3) "Karn, Scion of Urza"++      resolve "Reveal cards"+  , refute+      "requires card in play"+      "in play" $ do+        withLocation Graveyard $ addPlaneswalker 4 "Karn, Scion of Urza"+        activatePlaneswalker "Reveal cards" (-1) "Karn, Scion of Urza"+  , refute+      "requires card controlled by actor"+      "has controller Opponent" $ do+        withLocation Play $ addPlaneswalker 4 "Karn, Scion of Urza"+        as Opponent $+          activatePlaneswalker "Reveal cards" (-1) "Karn, Scion of Urza"+  , refute+      "requires sufficient loyalty"+      "does not have enough loyalty" $ do+        withLocation Play $ addPlaneswalker 1 "Karn, Scion of Urza"+        activatePlaneswalker "Create construct" (-2) "Karn, Scion of Urza"+  ]

@@ -0,0 +1,20 @@+module CopySpell where++import TestPrelude++test_CopySpell = testGroup "copySpell"+  [ prove "copies a spell on the stack" $ do+      withLocation (Active, Hand) $ addInstant "Shock"+      cast "" "Shock"++      copySpell "Shock (copy)" "Shock"++      resolve "Shock (copy)"+      resolve "Shock"+  , refute+      "spell must be on stack"+      "on stack" $ do+        withLocation (Active, Hand) $ addInstant "Shock"++        copySpell "Shock (copy)" "Shock"+  ]

@@ -0,0 +1,20 @@+module Destroy where++import TestPrelude.V2++test_Destroy = testGroup "destroy"+  [ prove "destroys a card in play" $ do+      withLocation Play $ addArtifact "Mox"+      destroy "Mox"+      validate (matchLocation (Active, Graveyard)) "Mox"+  , refute+      "cannot destroy indestructible"+      "not has attribute indestructible" $ do+        withLocation Play $ withAttribute indestructible $ addArtifact "Mox"+        destroy "Mox"+  , refute+      "requires in play"+      "in play" $ do+        withLocation Graveyard $ addArtifact "Mox"+        destroy "Mox"+  ]

@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover #-}+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --hide-successes  #-}

@@ -0,0 +1,46 @@+module Fight where++import TestPrelude++test_Fight = testGroup "fight"+  [ prove "adds damage to both creatures" $ do+      withLocation (Active, Play) $ addCreature (2, 4) "Angel 1"+      withLocation (Active, Play) $ addCreature (3, 4) "Angel 2"++      fight "Angel 1" "Angel 2"+      validate "Angel 1" $ matchDamage 3+      validate "Angel 2" $ matchDamage 2+  , prove "fighting self adds double damage" $ do+      withLocation (Active, Play) $ addCreature (2, 4) "Angel 1"++      fight "Angel 1" "Angel 1"+      validate "Angel 1" $ matchDamage 4+  , refute+      "require first card to be in play"+      "in play" $ do+        withLocation (Active, Graveyard) $ addCreature (2, 4) "Angel 1"+        withLocation (Active, Play) $ addCreature (3, 4) "Angel 2"++        fight "Angel 1" "Angel 2"+  , refute+      "require second card to be in play"+      "in play" $ do+        withLocation (Active, Play) $ addCreature (2, 4) "Angel 1"+        withLocation (Active, Graveyard) $ addCreature (3, 4) "Angel 2"++        fight "Angel 1" "Angel 2"+  , refute+      "require first card to be a creature"+      "has attribute creature" $ do+        withLocation (Active, Graveyard) $ addEnchantment "Angel 1"+        withLocation (Active, Play) $ addCreature (3, 4) "Angel 2"++        fight "Angel 1" "Angel 2"+  , refute+      "require second card to be a creature"+      "has attribute creature" $ do+        withLocation (Active, Play) $ addCreature (2, 4) "Angel 1"+        withLocation (Active, Graveyard) $ addEnchantment "Angel 2"++        fight "Angel 1" "Angel 2"+  ]

@@ -0,0 +1,39 @@+module ModifyStrength where++import TestPrelude.V2++test_ModifyStrength = testGroup "modifyStrength"+  [ prove "modifies effective strength of creature" $ do+      withLocation Play $ addCreature (1, 1) "Soldier"+      modifyStrength (1, 2) "Soldier"++      c <- requireCard "Soldier" mempty++      unless (view cardStrength c == mkStrength (2, 3)) $+        throwError "Did not modify strength"+  , prove "strength modification reset when card leaves play" $ do+      withLocation Play $ addCreature (1, 1) "Soldier"+      modifyStrength (1, 2) "Soldier"++      withStateBasedActions $ moveTo Graveyard "Soldier"++      c <- requireCard "Soldier" mempty++      unless (view cardStrength c == mkStrength (1, 1)) $+        throwError "Did not reset strength"+  , prove "works with SBAs to graveyard creature for <= 0 toughness" $ do+      withLocation Play $ addCreature (1, 1) "Soldier"+      withStateBasedActions $ modifyStrength (0, -1) "Soldier"++      validate (matchLocation (Active, Graveyard)) "Soldier"+  , refute+      "requires in play"+      "in play" $ do+        withLocation Hand $ addCreature (1, 1) "Soldier"+        modifyStrength (0, -1) "Soldier"+  , refute+      "requires creature"+      "has attribute creature" $ do+        withLocation Hand $ addArtifact "Soldier"+        modifyStrength (0, -1) "Soldier"+  ]

@@ -51,7 +51,7 @@         matchLocation (Active, Graveyard) <> matchPlusOneCounters 0   , prove "removes damage when leaving play" $ do       withLocation (Active, Play) $ addCreature (1, 1) "Zombie"-      modifyCard "Zombie" cardDamage (const 1)+      modifyCardDeprecated "Zombie" cardDamage (const 1)        moveTo Graveyard "Zombie" @@ -97,7 +97,7 @@         withLocation (Active, Hand) $ addInstant "Shock"          cast "" "Shock"-        copySpell "Shock" "Shock 1" >> resolveTop+        copySpell "Shock 1" "Shock" >> resolveTop          move (Active, Graveyard) (Active, Play) "Shock 1"   ]

@@ -0,0 +1,20 @@+module Sacrifice where++import TestPrelude.V2++test_Sacrifice = testGroup "sacrifice"+  [ prove "moves card to graveyard" $ do+      withLocation Play $ addArtifact "Mox"+      sacrifice "Mox"+      validate (matchLocation (Active, Graveyard)) "Mox"+  , refute+      "cannot sacrifice permanents owned by opponent"+      "has controller Active" $ do+        as Opponent $ withLocation Play $ addArtifact "Mox"+        sacrifice "Mox"+  , refute+      "requires in play"+      "in play" $ do+        withLocation Graveyard $ addArtifact "Mox"+        destroy "Mox"+  ]

@@ -116,32 +116,6 @@         addMana "10"         validateBoardEquals (manaPool . at Active . _Just) (replicate 10 'X')     ]-  , testGroup "tap"-    [ prove "taps card in play" $ do-        withLocation (Active, Play) $ addLand "Forest"-        tap "Forest"--        validate "Forest" $ matchAttribute tapped-    , prove "taps card in opponent's play" $ do-        withLocation (Active, Play) $ addLand "Forest"-        tap "Forest"--        validate "Forest" $ matchAttribute tapped-    , refute-        "requires card exists"-        "Card does not exist: Forest" $ do-          tap "Forest"-    , refute-        "requires untapped"-        "not has attribute tapped" $ do-          withAttribute tapped $ withLocation (Active, Play) $ addLand "Forest"-          tap "Forest"-    , refute-        "requires in play"-        "in play" $ do-          withLocation (Active, Graveyard) $ addLand "Forest"-          tap "Forest"-    ]   , testGroup "tapForMana"     [ prove "taps card and adds mana to pool" $ do         withLocation (Active, Play) $ addLand "Forest"@@ -280,6 +254,13 @@             withAttributes [summoned] $ addCreature (1, 1) "Bat"            attackWith ["Bat"]+    , refute+        "prevents defenders from attacking"+        "not has attribute defender" $ do+          withLocation (Active, Play) $ do+            withAttributes [defender] $ addCreature (1, 1) "Wall"++          attackWith ["Wall"]     , prove "allows hasty creatures to attack" $ do         withLocation (Active, Play) $ do           withAttributes [haste, summoned] $ addCreature (1, 1) "Bat"

@@ -1,60 +1,68 @@ module StateBasedActions where -import TestPrelude+import TestPrelude.V2  test_SBAs = testGroup "state-based actions"   [ prove "destroys creature with damage exceeding toughness" $ do       withStateBasedActions $ do-        withLocation (Active, Play)+        withLocation Play           $ addCreature (1, 1) "Spirit"          damage (const 2) (targetCard "Spirit") "Spirit" -      validate "Spirit" $ matchLocation (Active, Graveyard)+      validate (matchLocation (Active, Graveyard)) "Spirit"   , prove "destroys deathtouched creature" $ do       withStateBasedActions $ do-        withLocation (Active, Play)+        withLocation Play           $ withAttribute deathtouched           $ addCreature (1, 1) "Spirit" -      validate "Spirit" $ matchLocation (Active, Graveyard)+      validate (matchLocation (Active, Graveyard)) "Spirit"   , prove "does not destroy indestructible creature" $ do       withStateBasedActions $ do-        withLocation (Active, Play)+        withLocation Play           $ withAttributes [indestructible, deathtouched]           $ addCreature (1, 1) "Spirit"          damage (const 2) (targetCard "Spirit") "Spirit" -      validate "Spirit" $ matchInPlay+      validate matchInPlay "Spirit"    , prove "removes tokens not in play" $ do        withStateBasedActions $ do-         withLocation (Active, Graveyard)+         withLocation Graveyard            $ withAttribute token            $ addArtifact "Treasure"         validateRemoved "Treasure"    , prove "does not remove copies on stack" $ do        withStateBasedActions $ do-         withLocation (Active, Hand)+         withLocation Hand            $ withAttribute copy            $ addArtifact "Shock"          cast "" "Shock" -       validate "Shock" $ matchLocation (Active, Stack)+       validate (matchLocation (Active, Stack)) "Shock"    , prove "removes copies not on stack" $ do        withStateBasedActions $ do-         withLocation (Active, Graveyard)+         withLocation Graveyard            $ withAttribute copy            $ addArtifact "Shock"         validateRemoved "Shock"    , prove "correctly removes damaged tokens" $ do        withStateBasedActions $ do-         withLocation (Active, Play)+         withLocation Play            $ withAttribute token            $ addCreature (1, 1) "Spirit"           damage (const 1) (targetCard "Spirit") "Spirit"        validateRemoved "Spirit"+   , prove "cancels out +1/+1 and -1/-1 counters" $ do+       withStateBasedActions $ do+         withLocation Play+           $ withPlusOneCounters 3+           $ withMinusOneCounters 2+           $ addCreature (5, 5) "Dinosaur"++       validate (matchPlusOneCounters 1 <> matchMinusOneCounters 0) "Dinosaur"   ]

@@ -0,0 +1,43 @@+module Tap where++import TestPrelude.V2++test_Tap = testGroup "tap"+  [ prove "taps card in play" $ do+      withLocation Play $ addLand "Forest"+      tap "Forest"++      validate (matchAttribute tapped) "Forest"+  , prove "taps card in opponent's play" $ do+      withLocation Play $ addLand "Forest"+      tap "Forest"++      validate (matchAttribute tapped) "Forest"+  , prove "taps creature without summoning sickness" $ do+     withLocation Play $ addCreature (1, 1) "Goblin"+     tap "Goblin"+  , prove "taps creature with haste" $ do+     withLocation Hand $ withAttribute haste $ addCreature (1, 1) "Goblin"+     cast "" "Goblin" >> resolveTop+     tap "Goblin"+  , refute+      "requires card exists"+      "Card does not exist: Forest" $ do+        tap "Forest"+  , refute+      "requires untapped"+      "not has attribute tapped" $ do+        withAttribute tapped $ withLocation Play $ addLand "Forest"+        tap "Forest"+  , refute+      "requires in play"+      "in play" $ do+        withLocation Graveyard $ addLand "Forest"+        tap "Forest"+  , refute+     "requires creature not summoned"+     "does not have summoning sickness" $ do+       withLocation Hand $ addCreature (1, 1) "Soldier"+       cast "" "Soldier" >> resolveTop+       tap "Soldier"+  ]

@@ -0,0 +1,23 @@+module Target where++import TestPrelude.V2++test_Target = testGroup "target"+  [ prove "targets a card in play" $ do+      withLocation Play $ addArtifact "Mox"+      target "Mox"+  , prove "targets own card with hexproof" $ do+      withLocation Play $ withAttribute hexproof $ addArtifact "Mox"+      target "Mox"+  , refute+      "cannot target hexproof of opponent"+      "not has attribute hexproof" $ do+        as Opponent $ do+          withLocation Play $ withAttribute hexproof $ addArtifact "Mox"+        target "Mox"+  , refute+      "requires in play"+      "in play" $ do+        withLocation Graveyard $ addArtifact "Mox"+        target "Mox"+  ]

@@ -0,0 +1,14 @@+module TargetInLocation where++import TestPrelude.V2++test_Target = testGroup "targetInLocation"+  [ prove "targets a card in graveyard" $ do+      withLocation Graveyard $ addArtifact "Mox"+      targetInLocation (Active, Graveyard) "Mox"+  , refute+      "requires location"+      "in location (Active,Graveyard)" $ do+        withLocation Play $ addArtifact "Mox"+        targetInLocation (Active, Graveyard) "Mox"+  ]

@@ -9,6 +9,7 @@   , prove   , refute   , validateBoardEquals+  , throwError   ) where  import Test.Tasty@@ -23,7 +24,6 @@ import Control.Lens import Control.Monad.Except - prove name m = testCase name $   case runMonad emptyBoard m of     (Left msg, _, _) -> assertFailure msg@@ -39,4 +39,3 @@    unless (x == expected) $     throwError ("want: " <> show expected <> ", got: " <> show x)-

@@ -10,4 +10,5 @@   , validate   , validateLife   , withLocation+  , fork   )