diff options
Diffstat (limited to 'src/Xanthous/Entities')
-rw-r--r-- | src/Xanthous/Entities/Character.hs | 21 | ||||
-rw-r--r-- | src/Xanthous/Entities/SomeEntity.hs | 34 |
2 files changed, 55 insertions, 0 deletions
diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs new file mode 100644 index 000000000000..5cf397e82232 --- /dev/null +++ b/src/Xanthous/Entities/Character.hs @@ -0,0 +1,21 @@ +module Xanthous.Entities.Character + ( Character(..) + , mkCharacter + ) where + +import Xanthous.Prelude +import Test.QuickCheck + +import Xanthous.Entities + +data Character where + Character :: Character + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (CoArbitrary, Function) + deriving Draw via (DrawCharacter "@" Character) + +instance Arbitrary Character where + arbitrary = pure Character + +mkCharacter :: Character +mkCharacter = Character diff --git a/src/Xanthous/Entities/SomeEntity.hs b/src/Xanthous/Entities/SomeEntity.hs new file mode 100644 index 000000000000..029247de9b7f --- /dev/null +++ b/src/Xanthous/Entities/SomeEntity.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE GADTs #-} +module Xanthous.Entities.SomeEntity + ( SomeEntity(..) + , downcastEntity + ) where + +import Xanthous.Prelude +import Test.QuickCheck (Arbitrary(..)) +import qualified Test.QuickCheck.Gen as Gen + +import Xanthous.Entities (Draw(..), Entity) +import Data.Typeable +import Xanthous.Entities.Character + +data SomeEntity where + SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity + +instance Show SomeEntity where + show (SomeEntity x) = "SomeEntity (" <> show x <> ")" + +instance Eq SomeEntity where + (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of + Just Refl -> a == b + _ -> False + +instance Arbitrary SomeEntity where + arbitrary = Gen.oneof + [pure $ SomeEntity Character] + +instance Draw SomeEntity where + draw (SomeEntity ent) = draw ent + +downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a +downcastEntity (SomeEntity e) = cast e |