module Data.Aztecs.Core (Entity (..), EntityComponent (..)) where

newtype Entity = Entity Int deriving (Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
/= :: Entity -> Entity -> Bool
Eq, Eq Entity
Eq Entity =>
(Entity -> Entity -> Ordering)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> Ord Entity
Entity -> Entity -> Bool
Entity -> Entity -> Ordering
Entity -> Entity -> Entity
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
$ccompare :: Entity -> Entity -> Ordering
compare :: Entity -> Entity -> Ordering
$c< :: Entity -> Entity -> Bool
< :: Entity -> Entity -> Bool
$c<= :: Entity -> Entity -> Bool
<= :: Entity -> Entity -> Bool
$c> :: Entity -> Entity -> Bool
> :: Entity -> Entity -> Bool
$c>= :: Entity -> Entity -> Bool
>= :: Entity -> Entity -> Bool
$cmax :: Entity -> Entity -> Entity
max :: Entity -> Entity -> Entity
$cmin :: Entity -> Entity -> Entity
min :: Entity -> Entity -> Entity
Ord, Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
(Int -> Entity -> ShowS)
-> (Entity -> String) -> ([Entity] -> ShowS) -> Show Entity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entity -> ShowS
showsPrec :: Int -> Entity -> ShowS
$cshow :: Entity -> String
show :: Entity -> String
$cshowList :: [Entity] -> ShowS
showList :: [Entity] -> ShowS
Show)

data EntityComponent a = EntityComponent Entity a deriving (Int -> EntityComponent a -> ShowS
[EntityComponent a] -> ShowS
EntityComponent a -> String
(Int -> EntityComponent a -> ShowS)
-> (EntityComponent a -> String)
-> ([EntityComponent a] -> ShowS)
-> Show (EntityComponent a)
forall a. Show a => Int -> EntityComponent a -> ShowS
forall a. Show a => [EntityComponent a] -> ShowS
forall a. Show a => EntityComponent a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> EntityComponent a -> ShowS
showsPrec :: Int -> EntityComponent a -> ShowS
$cshow :: forall a. Show a => EntityComponent a -> String
show :: EntityComponent a -> String
$cshowList :: forall a. Show a => [EntityComponent a] -> ShowS
showList :: [EntityComponent a] -> ShowS
Show)