{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

module Dovin.Types where

import Control.Lens (Lens', makeLenses, over, view, _1, _2, at, non)
import Control.Monad.Reader (ReaderT, Reader)
import Control.Monad.Identity (runIdentity, Identity)
import Control.Monad.Except (ExceptT)
import Control.Monad.State (StateT)
import Control.Monad.Writer (WriterT)
import qualified Data.HashMap.Strict as M
import Data.Hashable (Hashable)
import qualified Data.Set as S
import GHC.Generics

data Color = Red | Green | Blue | Black | White deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord)
type Colors = S.Set Color

type CardName = String
type CardAttribute = String
data Player = Active | Opponent deriving (Int -> Player -> ShowS
[Player] -> ShowS
Player -> String
(Int -> Player -> ShowS)
-> (Player -> String) -> ([Player] -> ShowS) -> Show Player
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Player] -> ShowS
$cshowList :: [Player] -> ShowS
show :: Player -> String
$cshow :: Player -> String
showsPrec :: Int -> Player -> ShowS
$cshowsPrec :: Int -> Player -> ShowS
Show, Player -> Player -> Bool
(Player -> Player -> Bool)
-> (Player -> Player -> Bool) -> Eq Player
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Player -> Player -> Bool
$c/= :: Player -> Player -> Bool
== :: Player -> Player -> Bool
$c== :: Player -> Player -> Bool
Eq, (forall x. Player -> Rep Player x)
-> (forall x. Rep Player x -> Player) -> Generic Player
forall x. Rep Player x -> Player
forall x. Player -> Rep Player x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Player x -> Player
$cfrom :: forall x. Player -> Rep Player x
Generic, Eq Player
Eq Player
-> (Player -> Player -> Ordering)
-> (Player -> Player -> Bool)
-> (Player -> Player -> Bool)
-> (Player -> Player -> Bool)
-> (Player -> Player -> Bool)
-> (Player -> Player -> Player)
-> (Player -> Player -> Player)
-> Ord Player
Player -> Player -> Bool
Player -> Player -> Ordering
Player -> Player -> Player
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Player -> Player -> Player
$cmin :: Player -> Player -> Player
max :: Player -> Player -> Player
$cmax :: Player -> Player -> Player
>= :: Player -> Player -> Bool
$c>= :: Player -> Player -> Bool
> :: Player -> Player -> Bool
$c> :: Player -> Player -> Bool
<= :: Player -> Player -> Bool
$c<= :: Player -> Player -> Bool
< :: Player -> Player -> Bool
$c< :: Player -> Player -> Bool
compare :: Player -> Player -> Ordering
$ccompare :: Player -> Player -> Ordering
$cp1Ord :: Eq Player
Ord)
-- This is pretty dodgy - one char per mana - but works for now.
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 | Deck
  deriving (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Eq Location
Eq Location
-> (Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c< :: Location -> Location -> Bool
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
$cp1Ord :: Eq Location
Ord)

-- The original CardEffect type. This is deprecated as of V3, replaced by
-- LayeredEffect.
data CardEffect = CardEffect
  { CardEffect -> CardMatcher
_effectEnabled :: CardMatcher
  , CardEffect -> Card -> CardMatcher
_effectFilter :: Card -> CardMatcher
  , CardEffect -> Card -> GameMonad Card
_effectAction :: Card -> GameMonad Card
  }

-- A monad for writing effect definitions.
type EffectMonadEnv = (Board, Card)
type EffectMonad a = Reader EffectMonadEnv a

-- These layers line up to those specified in the official rules (613).
data Layer =
    Layer1A -- ^ Copiable effects
  | Layer1B -- ^ Face down spells and permanents
  | Layer2  -- ^ Control-changing effects
  | Layer3  -- ^ Text changing effects
  | Layer4  -- ^ Type changing effects
  | Layer5  -- ^ Color changing effects
  | Layer6  -- ^ Ability changing effects
  | Layer7A -- ^ P/T from CDAs
  | Layer7B -- ^ P/T from setting
  | Layer7C -- ^ P/T adjustments (inc. counters)
  | Layer7D -- ^ P/T Switching
  | LayerOther -- ^ Other game rule affecting effects
  deriving (Int -> Layer -> ShowS
[Layer] -> ShowS
Layer -> String
(Int -> Layer -> ShowS)
-> (Layer -> String) -> ([Layer] -> ShowS) -> Show Layer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layer] -> ShowS
$cshowList :: [Layer] -> ShowS
show :: Layer -> String
$cshow :: Layer -> String
showsPrec :: Int -> Layer -> ShowS
$cshowsPrec :: Int -> Layer -> ShowS
Show, Eq Layer
Eq Layer
-> (Layer -> Layer -> Ordering)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Layer)
-> (Layer -> Layer -> Layer)
-> Ord Layer
Layer -> Layer -> Bool
Layer -> Layer -> Ordering
Layer -> Layer -> Layer
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Layer -> Layer -> Layer
$cmin :: Layer -> Layer -> Layer
max :: Layer -> Layer -> Layer
$cmax :: Layer -> Layer -> Layer
>= :: Layer -> Layer -> Bool
$c>= :: Layer -> Layer -> Bool
> :: Layer -> Layer -> Bool
$c> :: Layer -> Layer -> Bool
<= :: Layer -> Layer -> Bool
$c<= :: Layer -> Layer -> Bool
< :: Layer -> Layer -> Bool
$c< :: Layer -> Layer -> Bool
compare :: Layer -> Layer -> Ordering
$ccompare :: Layer -> Layer -> Ordering
$cp1Ord :: Eq Layer
Ord, Layer -> Layer -> Bool
(Layer -> Layer -> Bool) -> (Layer -> Layer -> Bool) -> Eq Layer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layer -> Layer -> Bool
$c/= :: Layer -> Layer -> Bool
== :: Layer -> Layer -> Bool
$c== :: Layer -> Layer -> Bool
Eq, Layer
Layer -> Layer -> Bounded Layer
forall a. a -> a -> Bounded a
maxBound :: Layer
$cmaxBound :: Layer
minBound :: Layer
$cminBound :: Layer
Bounded, Int -> Layer
Layer -> Int
Layer -> [Layer]
Layer -> Layer
Layer -> Layer -> [Layer]
Layer -> Layer -> Layer -> [Layer]
(Layer -> Layer)
-> (Layer -> Layer)
-> (Int -> Layer)
-> (Layer -> Int)
-> (Layer -> [Layer])
-> (Layer -> Layer -> [Layer])
-> (Layer -> Layer -> [Layer])
-> (Layer -> Layer -> Layer -> [Layer])
-> Enum Layer
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Layer -> Layer -> Layer -> [Layer]
$cenumFromThenTo :: Layer -> Layer -> Layer -> [Layer]
enumFromTo :: Layer -> Layer -> [Layer]
$cenumFromTo :: Layer -> Layer -> [Layer]
enumFromThen :: Layer -> Layer -> [Layer]
$cenumFromThen :: Layer -> Layer -> [Layer]
enumFrom :: Layer -> [Layer]
$cenumFrom :: Layer -> [Layer]
fromEnum :: Layer -> Int
$cfromEnum :: Layer -> Int
toEnum :: Int -> Layer
$ctoEnum :: Int -> Layer
pred :: Layer -> Layer
$cpred :: Layer -> Layer
succ :: Layer -> Layer
$csucc :: Layer -> Layer
Enum)

allLayers :: [Layer]
allLayers :: [Layer]
allLayers = [Layer
forall a. Bounded a => a
minBound..Layer
forall a. Bounded a => a
maxBound]

-- The atomic component of an effect, that should only affect attributes at the
-- specified layer.
data LayeredEffectPart = LayeredEffectPart Layer (Card -> EffectMonad Card)

-- An effect is combined of multiple parts that each apply at different layers.
-- So called to distinguish it from the deprecated CardEffect type.
type LayeredEffect = [LayeredEffectPart]

-- An effect definition best matches up to the text describing it on a card. It
-- can generate different effects affecting different cards depending on the
-- state of the board.
data LayeredEffectDefinition = LayeredEffectDefinition
  { LayeredEffectDefinition -> EffectMonad CardMatcher
_leAppliesTo :: EffectMonad CardMatcher -- ^ Filter to determine which
                                            -- cards are affected by this
                                            -- effect, if enabled.
  , LayeredEffectDefinition -> LayeredEffect
_leEffect :: LayeredEffect -- ^ The actions to apply to affected cards.
  , LayeredEffectDefinition -> String
_leName :: EffectName      -- ^ A human readable description of the effect.
                               -- Optional.
  }


mkEffect ::
  CardMatcher
  -> (Card -> CardMatcher)
  -> (Card -> Identity Card)
  -> CardEffect
mkEffect :: CardMatcher
-> (Card -> CardMatcher) -> (Card -> Identity Card) -> CardEffect
mkEffect CardMatcher
enabled Card -> CardMatcher
filter Card -> Identity Card
action = CardEffect :: CardMatcher
-> (Card -> CardMatcher) -> (Card -> GameMonad Card) -> CardEffect
CardEffect
  -- For an effect to be enabled, it's host card must currently match this
  -- matcher.
  { _effectEnabled :: CardMatcher
_effectEnabled = CardMatcher
enabled
  -- If the effect is enabled, this filter determines wheter any particular
  -- card is affected by it.
  , _effectFilter :: Card -> CardMatcher
_effectFilter = Card -> CardMatcher
filter
  -- The action to apply to affected cards.
  , _effectAction :: Card -> GameMonad Card
_effectAction = Card -> GameMonad Card
forall (m :: * -> *) a. Monad m => a -> m a
return (Card -> GameMonad Card)
-> (Card -> Card) -> Card -> GameMonad Card
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Card -> Card
forall a. Identity a -> a
runIdentity (Identity Card -> Card) -> (Card -> Identity Card) -> Card -> Card
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Card -> Identity Card
action
  }

mkLayeredEffectPart :: EffectMonad CardMatcher
-> LayeredEffect -> String -> LayeredEffectDefinition
mkLayeredEffectPart EffectMonad CardMatcher
appliesTo LayeredEffect
effect String
name = LayeredEffectDefinition :: EffectMonad CardMatcher
-> LayeredEffect -> String -> LayeredEffectDefinition
LayeredEffectDefinition
  { _leAppliesTo :: EffectMonad CardMatcher
_leAppliesTo = EffectMonad CardMatcher
appliesTo
  , _leEffect :: LayeredEffect
_leEffect = LayeredEffect
effect
  , _leName :: String
_leName = String
name
  }

-- A target for a spell or ability.
data Target =
    TargetPlayer Player -- ^ Target a player, use 'targetPlayer' to construct.
  | TargetCard CardName -- ^ Target a card, use 'targetCard' to construct.
  deriving (Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq, Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show)

targetPlayer :: Player -> Target
targetPlayer = Player -> Target
TargetPlayer
targetCard :: String -> Target
targetCard = String -> Target
TargetCard

type CardLocation = (Player, Location)
type CardAttributes = S.Set CardAttribute
data CardStrength = CardStrength Int Int deriving (CardStrength -> CardStrength -> Bool
(CardStrength -> CardStrength -> Bool)
-> (CardStrength -> CardStrength -> Bool) -> Eq CardStrength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CardStrength -> CardStrength -> Bool
$c/= :: CardStrength -> CardStrength -> Bool
== :: CardStrength -> CardStrength -> Bool
$c== :: CardStrength -> CardStrength -> Bool
Eq)
instance Show CardStrength where
  show :: CardStrength -> String
show (CardStrength Int
p Int
t) = Int -> String
forall a. Show a => a -> String
show Int
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
t

-- | A phase or step in a turn. Phases and steps are not distinguished between
-- because haven't seen a need to.
data Phase
  = Untap
  | Upkeep
  | DrawStep
  | FirstMain
  | BeginCombat
  | DeclareAttackers
  | DeclareBlockers
  | FirstStrikeDamage
  | CombatDamage
  | EndCombat
  | SecondMain
  | EndStep
  | Won Player
  deriving (Int -> Phase -> ShowS
[Phase] -> ShowS
Phase -> String
(Int -> Phase -> ShowS)
-> (Phase -> String) -> ([Phase] -> ShowS) -> Show Phase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Phase] -> ShowS
$cshowList :: [Phase] -> ShowS
show :: Phase -> String
$cshow :: Phase -> String
showsPrec :: Int -> Phase -> ShowS
$cshowsPrec :: Int -> Phase -> ShowS
Show, Phase -> Phase -> Bool
(Phase -> Phase -> Bool) -> (Phase -> Phase -> Bool) -> Eq Phase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Phase -> Phase -> Bool
$c/= :: Phase -> Phase -> Bool
== :: Phase -> Phase -> Bool
$c== :: Phase -> Phase -> Bool
Eq, Eq Phase
Eq Phase
-> (Phase -> Phase -> Ordering)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Phase)
-> (Phase -> Phase -> Phase)
-> Ord Phase
Phase -> Phase -> Bool
Phase -> Phase -> Ordering
Phase -> Phase -> Phase
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Phase -> Phase -> Phase
$cmin :: Phase -> Phase -> Phase
max :: Phase -> Phase -> Phase
$cmax :: Phase -> Phase -> Phase
>= :: Phase -> Phase -> Bool
$c>= :: Phase -> Phase -> Bool
> :: Phase -> Phase -> Bool
$c> :: Phase -> Phase -> Bool
<= :: Phase -> Phase -> Bool
$c<= :: Phase -> Phase -> Bool
< :: Phase -> Phase -> Bool
$c< :: Phase -> Phase -> Bool
compare :: Phase -> Phase -> Ordering
$ccompare :: Phase -> Phase -> Ordering
$cp1Ord :: Eq Phase
Ord)

type Timestamp = Integer
data EffectDuration = EndOfTurn

data AbilityEffect = AbilityEffect Timestamp EffectDuration [LayeredEffectPart]

data Card = Card
  { Card -> String
_cardName :: CardName
  , Card -> (Player, Location)
_location :: (Player, Location)
  , Card -> Player
_cardOwner :: Player
  , Card -> CardAttributes
_cardDefaultAttributes :: CardAttributes
  , Card -> CardAttributes
_cardAttributes :: CardAttributes
  , Card -> CardStrength
_cardStrength :: CardStrength
  , Card -> CardStrength
_cardStrengthModifier :: CardStrength
  , Card -> Int
_cardDamage :: Int
  , Card -> Int
_cardLoyalty :: Int
  , Card -> [CardEffect]
_cardEffects :: [CardEffect]
  , Card -> Int
_cardCmc :: Int
  , Card -> Colors
_cardColors :: Colors
  , Card -> [Target]
_cardTargets :: [Target]

  , Card -> Timestamp
_cardTimestamp :: Timestamp
  -- These are typically set when a card is created. They can be removed by
  -- "lose all abilities" effects.
  , Card -> [LayeredEffectDefinition]
_cardPassiveEffects :: [LayeredEffectDefinition]
  -- These are added as the result of spells or abilities. Typically are
  -- cleared when a card changes zones(?)
  , Card -> [AbilityEffect]
_cardAbilityEffects :: [AbilityEffect]

  -- Can probably generalize this more at some point.
  , Card -> Int
_cardPlusOneCounters :: Int
  , Card -> Int
_cardMinusOneCounters :: Int
  }
instance Hashable Player
instance Show Card where
  show :: Card -> String
show Card
c = Card -> String
_cardName Card
c String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show (CardAttributes -> [String]
forall a. Set a -> [a]
S.toList (CardAttributes -> [String]) -> CardAttributes -> [String]
forall a b. (a -> b) -> a -> b
$ Card -> CardAttributes
_cardAttributes Card
c)
instance Eq Card where
  Card
a == :: Card -> Card -> Bool
== Card
b = Card -> String
_cardName Card
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Card -> String
_cardName Card
b

newtype BaseCard = BaseCard Card deriving (Int -> BaseCard -> ShowS
[BaseCard] -> ShowS
BaseCard -> String
(Int -> BaseCard -> ShowS)
-> (BaseCard -> String) -> ([BaseCard] -> ShowS) -> Show BaseCard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseCard] -> ShowS
$cshowList :: [BaseCard] -> ShowS
show :: BaseCard -> String
$cshow :: BaseCard -> String
showsPrec :: Int -> BaseCard -> ShowS
$cshowsPrec :: Int -> BaseCard -> ShowS
Show, BaseCard -> BaseCard -> Bool
(BaseCard -> BaseCard -> Bool)
-> (BaseCard -> BaseCard -> Bool) -> Eq BaseCard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseCard -> BaseCard -> Bool
$c/= :: BaseCard -> BaseCard -> Bool
== :: BaseCard -> BaseCard -> Bool
$c== :: BaseCard -> BaseCard -> Bool
Eq)

data CardMatcher = CardMatcher String (Card -> Bool)
type EffectName = String

data Board = Board
  { Board -> HashMap String BaseCard
_cards :: M.HashMap CardName BaseCard
  , Board -> HashMap String Card
_resolvedCards :: M.HashMap CardName Card

  -- The stack is currently the only location where we care about order, so
  -- store that information alongside the main _cards map. This won't scale -
  -- deck and graveyard need to be ordered also - but works for now. Need to
  -- think more about "hiding" this data structure.
  , Board -> [String]
_stack :: [CardName]
  -- ... well I guess the deck cares about order too now hmmm. Need to figure
  -- this out.
  , Board -> HashMap Player [String]
_deck :: M.HashMap Player [CardName]
  , Board -> HashMap String Int
_counters :: M.HashMap String Int
  -- In theory, life could be just another counter. Need to think more about
  -- making that happen.
  , Board -> HashMap Player Int
_life :: M.HashMap Player Int
  , Board -> HashMap Player String
_manaPool :: M.HashMap Player ManaPool
  , Board -> Phase
_phase :: Phase
  , Board -> StepIdentifier
_currentStep :: StepIdentifier
  , Board -> Timestamp
_currentTime :: Timestamp
  }

data Env = Env
  { Env -> Card
_envTemplate :: Card
  , Env -> Bool
_envSBAEnabled :: Bool
  , Env -> Player
_envActor :: Player
  , Env -> Maybe Player
_envOwner :: Maybe Player
  }

type StepIdentifier = (Maybe String, Int)
data Step = Step
  { Step -> StepIdentifier
_stepId :: StepIdentifier
  , Step -> String
_stepLabel :: String
  , Step -> Board
_stepState :: Board
  }

type GameMonad a
   = (ExceptT String (ReaderT Env (StateT Board (WriterT [Step] Identity)))) a
type Formatter = Board -> String

incrementStep :: StepIdentifier -> StepIdentifier
incrementStep :: StepIdentifier -> StepIdentifier
incrementStep (Maybe String
f, Int
s) = (Maybe String
f, Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

makeLenses ''Board
makeLenses ''Card
makeLenses ''CardEffect
makeLenses ''Env
makeLenses ''Step
makeLenses ''LayeredEffectDefinition

stepFork :: Control.Lens.Lens' Step (Maybe String)
stepFork :: (Maybe String -> f (Maybe String)) -> Step -> f Step
stepFork = (StepIdentifier -> f StepIdentifier) -> Step -> f Step
Lens' Step StepIdentifier
stepId ((StepIdentifier -> f StepIdentifier) -> Step -> f Step)
-> ((Maybe String -> f (Maybe String))
    -> StepIdentifier -> f StepIdentifier)
-> (Maybe String -> f (Maybe String))
-> Step
-> f Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> f (Maybe String))
-> StepIdentifier -> f StepIdentifier
forall s t a b. Field1 s t a b => Lens s t a b
_1

stepNumber :: Control.Lens.Lens' Step Int
stepNumber :: (Int -> f Int) -> Step -> f Step
stepNumber = (StepIdentifier -> f StepIdentifier) -> Step -> f Step
Lens' Step StepIdentifier
stepId ((StepIdentifier -> f StepIdentifier) -> Step -> f Step)
-> ((Int -> f Int) -> StepIdentifier -> f StepIdentifier)
-> (Int -> f Int)
-> Step
-> f Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> StepIdentifier -> f StepIdentifier
forall s t a b. Field2 s t a b => Lens s t a b
_2

mkStep :: StepIdentifier -> String -> Board -> Step
mkStep StepIdentifier
id String
label Board
state = Step :: StepIdentifier -> String -> Board -> Step
Step
  { _stepId :: StepIdentifier
_stepId = StepIdentifier
id
  , _stepLabel :: String
_stepLabel = String
label
  , _stepState :: Board
_stepState = Board
state
  }

cardLocation :: Control.Lens.Lens' Card (Player, Location)
cardLocation :: ((Player, Location) -> f (Player, Location)) -> Card -> f Card
cardLocation = ((Player, Location) -> f (Player, Location)) -> Card -> f Card
Lens' Card (Player, Location)
location

-- TODO: How to define these lenses using built-in Lens primitives
-- (Control.Lens.Wrapped?)
cardPower :: Control.Lens.Lens' Card Int
cardPower :: (Int -> f Int) -> Card -> f Card
cardPower Int -> f Int
f Card
parent = (Int -> Card) -> f Int -> f Card
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\Int
x -> ASetter Card Card CardStrength CardStrength
-> (CardStrength -> CardStrength) -> Card -> Card
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Card Card CardStrength CardStrength
Lens' Card CardStrength
cardStrength (Int -> CardStrength -> CardStrength
setPower Int
x) Card
parent)
  (Int -> f Int
f (Int -> f Int) -> (Card -> Int) -> Card -> f Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardStrength -> Int
power (CardStrength -> Int) -> (Card -> CardStrength) -> Card -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting CardStrength Card CardStrength -> Card -> CardStrength
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CardStrength Card CardStrength
Lens' Card CardStrength
cardStrength (Card -> f Int) -> Card -> f Int
forall a b. (a -> b) -> a -> b
$ Card
parent)
  where
    setPower :: Int -> CardStrength -> CardStrength
setPower Int
p (CardStrength Int
_ Int
t) = Int -> Int -> CardStrength
CardStrength Int
p Int
t
    power :: CardStrength -> Int
power (CardStrength Int
p Int
_) = Int
p

cardToughness :: Control.Lens.Lens' Card Int
cardToughness :: (Int -> f Int) -> Card -> f Card
cardToughness Int -> f Int
f Card
parent = (Int -> Card) -> f Int -> f Card
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\Int
x -> ASetter Card Card CardStrength CardStrength
-> (CardStrength -> CardStrength) -> Card -> Card
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Card Card CardStrength CardStrength
Lens' Card CardStrength
cardStrength (Int -> CardStrength -> CardStrength
setToughness Int
x) Card
parent)
  (Int -> f Int
f (Int -> f Int) -> (Card -> Int) -> Card -> f Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardStrength -> Int
toughness (CardStrength -> Int) -> (Card -> CardStrength) -> Card -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting CardStrength Card CardStrength -> Card -> CardStrength
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CardStrength Card CardStrength
Lens' Card CardStrength
cardStrength (Card -> f Int) -> Card -> f Int
forall a b. (a -> b) -> a -> b
$ Card
parent)
  where
    setToughness :: Int -> CardStrength -> CardStrength
setToughness Int
t (CardStrength Int
p Int
_) = Int -> Int -> CardStrength
CardStrength Int
p Int
t
    toughness :: CardStrength -> Int
toughness (CardStrength Int
_ Int
t) = Int
t

cardController :: Control.Lens.Lens' Card Player
cardController :: (Player -> f Player) -> Card -> f Card
cardController = ((Player, Location) -> f (Player, Location)) -> Card -> f Card
Lens' Card (Player, Location)
cardLocation (((Player, Location) -> f (Player, Location)) -> Card -> f Card)
-> ((Player -> f Player)
    -> (Player, Location) -> f (Player, Location))
-> (Player -> f Player)
-> Card
-> f Card
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Player -> f Player) -> (Player, Location) -> f (Player, Location)
forall s t a b. Field1 s t a b => Lens s t a b
_1

manaPoolFor :: Player -> (String -> f String) -> Board -> f Board
manaPoolFor Player
p = (HashMap Player String -> f (HashMap Player String))
-> Board -> f Board
Lens' Board (HashMap Player String)
manaPool ((HashMap Player String -> f (HashMap Player String))
 -> Board -> f Board)
-> ((String -> f String)
    -> HashMap Player String -> f (HashMap Player String))
-> (String -> f String)
-> Board
-> f Board
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Player String)
-> Lens'
     (HashMap Player String) (Maybe (IxValue (HashMap Player String)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Player String)
Player
p ((Maybe String -> f (Maybe String))
 -> HashMap Player String -> f (HashMap Player String))
-> ((String -> f String) -> Maybe String -> f (Maybe String))
-> (String -> f String)
-> HashMap Player String
-> f (HashMap Player String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Iso' (Maybe String) String
forall a. Eq a => a -> Iso' (Maybe a) a
non String
forall a. Monoid a => a
mempty

-- I can't figure out the right type signature for manaPoolFor, so instead
-- providing this function to make it inferrable.
_manaPoolForTyping :: Board -> ManaPool
_manaPoolForTyping :: Board -> String
_manaPoolForTyping = Getting String Board String -> Board -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Player -> Getting String Board String
forall (f :: * -> *).
Functor f =>
Player -> (String -> f String) -> Board -> f Board
manaPoolFor Player
Active)

instance Show CardMatcher where
  show :: CardMatcher -> String
show (CardMatcher String
l Card -> Bool
_) = String
l

instance Semigroup CardMatcher where
  (CardMatcher String
d1 Card -> Bool
f) <> :: CardMatcher -> CardMatcher -> CardMatcher
<> (CardMatcher String
d2 Card -> Bool
g) =
    String -> (Card -> Bool) -> CardMatcher
CardMatcher (String
d1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
d2) ((Card -> Bool) -> CardMatcher) -> (Card -> Bool) -> CardMatcher
forall a b. (a -> b) -> a -> b
$ \Card
c -> Card -> Bool
f Card
c Bool -> Bool -> Bool
&& Card -> Bool
g Card
c

instance Monoid CardMatcher where
  mempty :: CardMatcher
mempty = String -> (Card -> Bool) -> CardMatcher
CardMatcher String
"" ((Card -> Bool) -> CardMatcher) -> (Card -> Bool) -> CardMatcher
forall a b. (a -> b) -> a -> b
$ Bool -> Card -> Bool
forall a b. a -> b -> a
const Bool
True

instance Semigroup CardStrength where
  CardStrength Int
p1 Int
t1 <> :: CardStrength -> CardStrength -> CardStrength
<> CardStrength Int
p2 Int
t2 =
   Int -> Int -> CardStrength
CardStrength (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p2) (Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t2)

instance Monoid CardStrength where
  mempty :: CardStrength
mempty = Int -> Int -> CardStrength
CardStrength Int
0 Int
0

emptyEnv :: Env
emptyEnv = Env :: Card -> Bool -> Player -> Maybe Player -> Env
Env
  { _envTemplate :: Card
_envTemplate = Card
emptyCard
  , _envSBAEnabled :: Bool
_envSBAEnabled = Bool
True
  , _envActor :: Player
_envActor = Player
Active
  , _envOwner :: Maybe Player
_envOwner = Maybe Player
forall a. Maybe a
Nothing
  }

mkStrength :: (Int, Int) -> CardStrength
mkStrength (Int
p, Int
t) = Int -> Int -> CardStrength
CardStrength Int
p Int
t
emptyCard :: Card
emptyCard = String -> (Player, Location) -> Card
mkCard String
"" (Player
Active, Location
Hand)
mkCard :: String -> (Player, Location) -> Card
mkCard String
name (Player, Location)
location =
  Card :: String
-> (Player, Location)
-> Player
-> CardAttributes
-> CardAttributes
-> CardStrength
-> CardStrength
-> Int
-> Int
-> [CardEffect]
-> Int
-> Colors
-> [Target]
-> Timestamp
-> [LayeredEffectDefinition]
-> [AbilityEffect]
-> Int
-> Int
-> Card
Card
    { _cardName :: String
_cardName = String
name
    , _location :: (Player, Location)
_location = (Player, Location)
location
    , _cardOwner :: Player
_cardOwner = (Player, Location) -> Player
forall a b. (a, b) -> a
fst (Player, Location)
location
    , _cardDefaultAttributes :: CardAttributes
_cardDefaultAttributes = CardAttributes
forall a. Monoid a => a
mempty
    , _cardColors :: Colors
_cardColors = Colors
forall a. Monoid a => a
mempty
    , _cardAttributes :: CardAttributes
_cardAttributes = CardAttributes
forall a. Monoid a => a
mempty
    , _cardStrength :: CardStrength
_cardStrength = CardStrength
forall a. Monoid a => a
mempty
    , _cardStrengthModifier :: CardStrength
_cardStrengthModifier = CardStrength
forall a. Monoid a => a
mempty
    , _cardDamage :: Int
_cardDamage = Int
0
    , _cardLoyalty :: Int
_cardLoyalty = Int
0
    , _cardEffects :: [CardEffect]
_cardEffects = [CardEffect]
forall a. Monoid a => a
mempty
    , _cardPlusOneCounters :: Int
_cardPlusOneCounters = Int
0
    , _cardMinusOneCounters :: Int
_cardMinusOneCounters = Int
0
    , _cardCmc :: Int
_cardCmc = Int
0
    , _cardTargets :: [Target]
_cardTargets = [Target]
forall a. Monoid a => a
mempty
    , _cardPassiveEffects :: [LayeredEffectDefinition]
_cardPassiveEffects = [LayeredEffectDefinition]
forall a. Monoid a => a
mempty
    , _cardAbilityEffects :: [AbilityEffect]
_cardAbilityEffects = [AbilityEffect]
forall a. Monoid a => a
mempty
    , _cardTimestamp :: Timestamp
_cardTimestamp = Timestamp
0
    }

opposing :: Player -> Player
opposing :: Player -> Player
opposing Player
Active = Player
Opponent
opposing Player
Opponent = Player
Active

emptyBoard :: Board
emptyBoard = Board :: HashMap String BaseCard
-> HashMap String Card
-> [String]
-> HashMap Player [String]
-> HashMap String Int
-> HashMap Player Int
-> HashMap Player String
-> Phase
-> StepIdentifier
-> Timestamp
-> Board
Board
               { _cards :: HashMap String BaseCard
_cards = HashMap String BaseCard
forall a. Monoid a => a
mempty
               , _resolvedCards :: HashMap String Card
_resolvedCards = HashMap String Card
forall a. Monoid a => a
mempty
               , _counters :: HashMap String Int
_counters = HashMap String Int
forall a. Monoid a => a
mempty
               , _stack :: [String]
_stack = [String]
forall a. Monoid a => a
mempty
               , _deck :: HashMap Player [String]
_deck = HashMap Player [String]
forall a. Monoid a => a
mempty
               , _life :: HashMap Player Int
_life = HashMap Player Int
forall a. Monoid a => a
mempty
               , _manaPool :: HashMap Player String
_manaPool = HashMap Player String
forall a. Monoid a => a
mempty
               , _phase :: Phase
_phase = Phase
FirstMain
               , _currentStep :: StepIdentifier
_currentStep = (Maybe String
forall a. Maybe a
Nothing, Int
0)
               , _currentTime :: Timestamp
_currentTime = Timestamp
0
               }