-
Notifications
You must be signed in to change notification settings - Fork 22
/
Types.hs
337 lines (273 loc) · 8.86 KB
/
Types.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Types where
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Identity
import Data.Label (mkLabels)
import Data.IntMap (IntMap)
import Data.Monoid
import Data.Set (Set)
import Data.Text (Text)
type Bag = []
newtype Ref a = Ref Int
type RefMap = IntMap
type RefSet a = Set (Ref a)
type WithRef a = (Ref a, a)
-- | Current game situation.
data World = World
{ _objects :: RefMap Object
, _players :: RefMap Player
, _activePlayer :: Ref Player
, _priority :: Ref Player
, _activeStep :: Step
, _stack :: [StackedEffect]
, _time :: Timestamp
}
-- Steps and phases
data Step
= BeginningPhase BeginningStep
| PrecombatMainPhase
| CombatPhase CombatStep
| PostcombatMainPhase
| EndPhase EndStep
deriving (Eq, Ord, Show, Read)
data BeginningStep
= UntapStep
| UpkeepStep
| DrawStep
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data CombatStep
= BeginningOfCombatStep
| DeclareAttackersStep
| DeclareBlockersStep
| CombatDamageStep
| EndOfCombatStep
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data EndStep
= EndOfTurnStep
| CleanupStep
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data Player = Player
{ _life :: Int
, _manaPool :: Bag (Maybe Color)
} deriving (Eq, Ord, Show)
-- Objects
data Card = Card
-- timestamp, owner (and controller), new ref
{ enterWorld :: Timestamp -> Ref Player -> Ref Object -> Object
}
data Object = Object
{ _name :: Maybe Text
, _colors :: Set Color
, _group :: Group
, _zone :: Zone
, _owner :: Ref Player
, _controller :: Ref Player
, _timestamp :: Timestamp
, _counters :: Bag CounterType
-- for permanents on the battlefield
, _tapStatus :: Maybe TapStatus
-- for spells on the stack
, _pendingEffect :: Maybe StackedEffect
-- for creatures on the battlefield
, _power :: Maybe Int
, _toughness :: Maybe Int
, _damage :: Maybe Int
, _mustBeBlocked :: Maybe Bool
, _mustAttack :: Maybe Bool
, _indestructible :: Bool
, _play :: Action
, _staticKeywordAbilities :: Bag StaticKeywordAbility
, _continuousEffects :: [ContinuousEffect] -- special form of static ability
, _activatedAbilities :: [Action]
, _triggeredAbilities :: [Event -> Special StackedEffect]
}
type Timestamp = Int
data Color = White | Blue | Black | Red | Green
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data Zone = Library | Hand | Stack | Battlefield | Graveyard | Exile
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data TapStatus = Untapped | Tapped
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data CounterType
= Charge | Plus1Plus1 | Minus1Minus1 | Poison | Hatchling | Loyalty
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data Group
= Spell { _spellType :: SpellType }
| Permanent
{ _supertypes :: Set Supertype
, _artifactTypes :: Maybe (Set ArtifactType)
, _creatureTypes :: Maybe (Set CreatureType)
, _enchantmentTypes :: Maybe (Set EnchantmentType)
, _landTypes :: Maybe (Set LandType)
, _planeswalkerTypes :: Maybe (Set PlaneswalkerType)
}
deriving (Eq, Ord, Show)
data SpellType = Instant | Sorcery
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data Supertype = Basic | Legendary
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data ArtifactType = Equipment
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data CreatureType
-- Races
= Boar
| Human
| Spirit
| Treefolk
| Insect
| Spider
| Devil
| Goblin
-- Roles
| Warrior
| Shaman
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data EnchantmentType = Aura | Curse
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data LandType = Plains | Island | Swamp | Mountain | Forest | Locus
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data PlaneswalkerType = Chandra | Elspeth | Garruk | Gideon | Jace
| Koth | Liliana | Sorin | Tezzeret | Venser | Karn
deriving (Eq, Ord, Show, Read, Enum, Bounded)
-- Actions
data Action = Action
{ _available :: Ref Player -> View Bool -- check for cost is implied
, _cost :: Cost
, _effect :: Special StackedEffect
}
data Cost = Cost
{ payColoredMana :: Bag Color
, payGenericMana :: Int
, tapPermanents :: [WithRef Object -> Bool]
, sacrificePermanents :: [WithRef Object -> Bool]
, exileObjects :: [WithRef Object -> Bool]
, discardCards :: Int
, removeCounters :: [(Int, CounterType)]
}
instance Monoid Cost where
mempty = Cost [] 0 [] [] [] 0 []
c1 `mappend` c2 = Cost
{ payColoredMana = payColoredMana c1 ++ payColoredMana c2
, payGenericMana = payGenericMana c1 + payGenericMana c2
, tapPermanents = tapPermanents c1 ++ tapPermanents c2
, sacrificePermanents = sacrificePermanents c1 ++ sacrificePermanents c2
, exileObjects = exileObjects c1 ++ exileObjects c2
, discardCards = discardCards c1 + discardCards c2
, removeCounters = removeCounters c1 ++ removeCounters c2
}
data StaticKeywordAbility
= Bloodthirst Int
| Deathtouch
| Defender
| DoubleStrike
| Enchant
| FirstStrike
| Flash
| Flashback Cost
| Flying
| Haste
| Hexproof
| Infect
| Intimidate
| Lifelink
| ProtectionFromColor Color
| Reach
| Shroud
| Trample
| Vigilance
data ContinuousEffect = ContinuousEffect
{ _layer :: Layer
, _efTimestamp :: Timestamp
, _efEffect :: World -> World
}
data Layer
= Layer1 -- copy effects
| Layer2 -- control-changing effects
| Layer3 -- text-changing effects
| Layer4 -- type-chaning effects
| Layer5 -- color-changing effects
| Layer6 -- ability-adding and ability-removing effects
| Layer7a -- p/t from characteristic-defining abilities
| Layer7b -- set p/t
| Layer7c -- modify p/t
| Layer7d -- p/t counters
| Layer7e -- switch p/t
| LayerPlayer -- player-affecting effects
| LayerRules -- rules-affecting effects
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data Event
= OneShotEffectEvent (OneShotEffect Ref)
-- Keyword actions [701]
| ActivateAbility (Ref Object) Int -- index of ability
| CastSpell (Ref Player) (Ref Object) -- controller, spell
| Counter (Ref Object) (Ref Object) -- source (spell or ability), target
| PlayLand (Ref Object)
| RegeneratePermanent (Ref Object)
| RevealCard (Ref Object)
| ChangeStep Step Step -- old step, new step
| LoseGame (Ref Player)
data OneShotEffect ref
= AdjustLife (ref Player) Int
| DamageObject (ref Object) (ref Object) Int Bool Bool -- source, creature/planeswalker, amount, combat damage?, preventable?
| DamagePlayer (ref Object) (ref Player) Int Bool Bool -- source, player, amount, combat damage?, preventable?
| ShuffleLibrary
-- | ReorderLibraryCards
| DrawCard -- Drawing is special [120.5]
| DestroyPermanent (ref Object) Bool -- target, preventable? -- Destruction is special [701.6b]
| MoveObject (ref Object) Zone Zone
| TapPermanent (ref Object)
| UntapPermanent (ref Object)
| AddCounter (ref Object) CounterType
| RemoveCounter (ref Object) CounterType
| CreateObject Object -- create a token, emblem or spell
| AddToManaPool (ref Player) (Bag (Maybe Color))
| AttachPermanent (ref Object) (Maybe (ref Object)) (Maybe (ref Object)) -- aura/equipment, old target, new target
| RemoveFromCombat (ref Object)
collectEffectRefs :: OneShotEffect ref -> ([ref Player], [ref Object])
collectEffectRefs = undefined
data MaybeRef a = MaybeRef (Maybe (Ref a))
data Choice
= ChoosePlayer (Ref Player)
| ChooseObject (Ref Object)
| ChooseColor Color
| ChooseNumber Int
| Pass
| Concede
-- Monads
type ViewT = ReaderT World
type View = ViewT Identity
data StackedEffect
= StackedEffect (Special [Event])
| StackedTarget (Target -> View Bool) Target (Target -> StackedEffect)
data MkStackedEffect
= MkStackedEffect (Special [Event])
| MkStackedTarget (Target -> View Bool) (Target -> MkStackedEffect)
resolve :: StackedEffect -> Special [Event]
resolve s =
case s of
StackedEffect x -> x
StackedTarget _ t f -> resolve (f t)
collectTargets :: StackedEffect -> [Target]
collectTargets s =
case s of
StackedEffect x -> []
StackedTarget _ t f -> t : collectTargets (f t)
data Special a
instance Functor Special
instance Applicative Special
instance Monad Special
instance MonadReader World Special
-- instance MonadPrompt Special
data Prompt a
= PromptReturn a
| PromptAsk (Ref Player)
data Target
= TargetPlayer (Ref Player)
| TargetObject (Ref Object)
$(mkLabels [''World, ''Player, ''Object, ''Zone, ''Group, ''Action])