Permalink
Browse files

Moved object types to new module ObjectTypes

  • Loading branch information...
1 parent 3702979 commit 406df1a8d454cd05e779b891d9db46fc932013cb @MedeaMelana committed Nov 8, 2012
Showing with 75 additions and 56 deletions.
  1. +1 −0 BasicLands.hs
  2. +1 −0 Engine.hs
  3. +1 −0 M12.hs
  4. +71 −0 ObjectTypes.hs
  5. +1 −56 Utils.hs
View
@@ -4,6 +4,7 @@ module BasicLands where
import Core
import Labels
+import ObjectTypes
import Predicates
import Utils
import Types
View
@@ -7,6 +7,7 @@ import Events
import IdList (Id)
import qualified IdList
import Labels
+import ObjectTypes
import Predicates
import Types
import Utils hiding (object)
View
1 M12.hs
@@ -4,6 +4,7 @@ module M12 where
import Core
import Types
+import ObjectTypes
import Utils
import Control.Applicative
View
@@ -0,0 +1,71 @@
+{-# LANGUAGE TypeOperators #-}
+
+module ObjectTypes (
+ -- * Convenient type sets
+ basicType, legendaryType,
+ artifactType, creatureType, enchantmentType, instantType, landType,
+ planeswalkerType, sorceryType,
+
+ -- * Class @ObjectType@
+ ObjectType(..), objectType, hasTypes,
+ ) where
+
+import Types
+
+import Data.Label.Pure (set, (:->))
+import Data.Monoid (mempty)
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+
+basicType :: ObjectTypes
+basicType = mempty { _supertypes = Set.singleton Basic }
+
+legendaryType :: ObjectTypes
+legendaryType = mempty { _supertypes = Set.singleton Legendary }
+
+artifactType :: ObjectTypes
+artifactType = mempty { _artifactSubtypes = Just mempty }
+
+creatureType :: ObjectTypes
+creatureType = mempty { _creatureSubtypes = Just mempty }
+
+enchantmentType :: ObjectTypes
+enchantmentType = mempty { _enchantmentSubtypes = Just mempty }
+
+instantType :: ObjectTypes
+instantType = mempty { _instantSubtypes = Just mempty }
+
+landType :: ObjectTypes
+landType = mempty { _landSubtypes = Just mempty }
+
+planeswalkerType :: ObjectTypes
+planeswalkerType = mempty { _planeswalkerSubtypes = Just mempty }
+
+sorceryType :: ObjectTypes
+sorceryType = mempty { _sorcerySubtypes = Just mempty }
+
+
+class ObjectType a where
+ objectTypeLabel :: ObjectTypes :-> Maybe (Set a)
+
+instance ObjectType ArtifactSubtype where
+ objectTypeLabel = artifactSubtypes
+
+instance ObjectType CreatureSubtype where
+ objectTypeLabel = creatureSubtypes
+
+instance ObjectType EnchantmentSubtype where
+ objectTypeLabel = enchantmentSubtypes
+
+instance ObjectType LandSubtype where
+ objectTypeLabel = landSubtypes
+
+instance ObjectType PlaneswalkerSubtype where
+ objectTypeLabel = planeswalkerSubtypes
+
+objectType :: ObjectType a => a -> ObjectTypes
+objectType ty = set objectTypeLabel (Just (Set.singleton ty)) mempty
+
+hasTypes :: Object -> ObjectTypes -> Bool
+hasTypes o t = t `isObjectTypesSubsetOf` _types o
View
@@ -9,10 +9,8 @@ import Types
import Control.Monad.State (State, execState)
import Data.Label.Pure
import Data.List (sortBy)
-import Data.Monoid
+import Data.Monoid (mempty)
import Data.Ord (comparing)
-import Data.Set (Set)
-import qualified Data.Set as Set
mkCard :: State Object () -> Card
@@ -57,59 +55,6 @@ object ts rOwner = Object
}
-basicType :: ObjectTypes
-basicType = mempty { _supertypes = Set.singleton Basic }
-
-legendaryType :: ObjectTypes
-legendaryType = mempty { _supertypes = Set.singleton Legendary }
-
-artifactType :: ObjectTypes
-artifactType = mempty { _artifactSubtypes = Just mempty }
-
-creatureType :: ObjectTypes
-creatureType = mempty { _creatureSubtypes = Just mempty }
-
-enchantmentType :: ObjectTypes
-enchantmentType = mempty { _enchantmentSubtypes = Just mempty }
-
-instantType :: ObjectTypes
-instantType = mempty { _instantSubtypes = Just mempty }
-
-landType :: ObjectTypes
-landType = mempty { _landSubtypes = Just mempty }
-
-planeswalkerType :: ObjectTypes
-planeswalkerType = mempty { _planeswalkerSubtypes = Just mempty }
-
-sorceryType :: ObjectTypes
-sorceryType = mempty { _sorcerySubtypes = Just mempty }
-
-
-class ObjectType a where
- objectTypeLabel :: ObjectTypes :-> Maybe (Set a)
-
-instance ObjectType ArtifactSubtype where
- objectTypeLabel = artifactSubtypes
-
-instance ObjectType CreatureSubtype where
- objectTypeLabel = creatureSubtypes
-
-instance ObjectType EnchantmentSubtype where
- objectTypeLabel = enchantmentSubtypes
-
-instance ObjectType LandSubtype where
- objectTypeLabel = landSubtypes
-
-instance ObjectType PlaneswalkerSubtype where
- objectTypeLabel = planeswalkerSubtypes
-
-objectType :: ObjectType a => a -> ObjectTypes
-objectType ty = set objectTypeLabel (Just (Set.singleton ty)) mempty
-
-hasTypes :: Object -> ObjectTypes -> Bool
-hasTypes o t = t `isObjectTypesSubsetOf` _types o
-
-
countCountersOfType :: CounterType -> Object -> Int
countCountersOfType ty o = length (filter (== ty) (get counters o))

0 comments on commit 406df1a

Please sign in to comment.