{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.Components
  ( -- * Component
    Component (..),
    ComponentId (..),
    Exclusivity (..),

    -- * Meta
    ComponentArchetypes (..),
    ComponentPairs (..),
    DefaultValue (..),
    Requires (..),
    RequiredBy (..),
    ComponentType (..),

    -- * Erasure
    ErasedComponent (..),
    tryGetComponent,
    DefaultComponentType (..),

    -- * Archetypes
    ArchetypeId (..),

    -- * Bundles
    BundleData (..),
    BundleElement (..),

    -- * Tables
    ComponentTicks (..),
    ComponentData (..),

    -- * Storage
    Components (..),
    emptyComponents,
    getComponentId,

    -- * Utils
    Pair (..),
    Rel (..),
    From (..),
    Res (..),
    ComponentRep (..),
    Tick (..),
    ErasedComponentEq (..),
    IsExclusive (..),
    isPair,
    setCompIdTarget,
    IsExclusiveRelationship (..),
  )
where

import Data.Default
import Data.HashTable.IO qualified as H
import Data.Kind
import Data.List qualified as List
import Data.Map (Map)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Typeable
import GHC.Base (Word (W#), Word#, compareWord#, eqWord#, isTrue#)
import GHC.Generics
import Mischief.ECS.Collectable
import Mischief.ECS.Components.HooksDef
import Mischief.ECS.EntityDef
import Mischief.ECS.Utils

data Exclusivity = Inclusive | Exclusive

-- | The @Component@ typeclass.
class (Typeable c, IsExclusive (IsExclusiveRel c)) => Component c where
  -- | List of components required by this one.
  -- All required components must be 'Default'
  --
  -- Example
  --
  -- @
  -- data A = A
  -- instance 'Component' A where
  --   'required' = 'Mischief.ECS.Components.Required.require' @(B, C)
  --
  -- data B = B 'Int' deriving ('Component', 'Generic', 'Default')
  --
  -- data C = C 'String' deriving ('Component')
  -- instance 'Default' C where
  --   'def' = C "Default String"
  -- @
  required :: Set DefaultComponentType
  required = Set DefaultComponentType
forall a. Set a
Set.empty

  type IsExclusiveRel c :: Bool
  type IsExclusiveRel c = False

  onAdd :: [Hook c]
  onAdd = []

  onSet :: [Hook c]
  onSet = []

  onRemove :: [Hook c]
  onRemove = []

  onAddRel :: [HookRel c]
  onAddRel = []

  onSetRel :: [HookRel c]
  onSetRel = []

  onRemoveRel :: [HookRel c]
  onRemoveRel = []

class IsExclusive (e :: Bool) where
  isExclusive :: Bool

instance IsExclusive False where
  isExclusive :: Bool
isExclusive = Bool
False

instance IsExclusive True where
  isExclusive :: Bool
isExclusive = Bool
True

-- | Unique id for components and component pairs.
data ComponentId = ComponentId (# Word#, Maybe Entity #)

instance Eq ComponentId where
  (==) :: ComponentId -> ComponentId -> Bool
  == :: ComponentId -> ComponentId -> Bool
(==) (ComponentId (# Word#
a, Maybe Entity
b #)) (ComponentId (# Word#
x, Maybe Entity
y #)) = Int# -> Bool
isTrue# (Word# -> Word# -> Int#
eqWord# Word#
a Word#
x) Bool -> Bool -> Bool
&& Maybe Entity
b Maybe Entity -> Maybe Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Entity
y

instance Ord ComponentId where
  compare :: ComponentId -> ComponentId -> Ordering
  compare :: ComponentId -> ComponentId -> Ordering
compare (ComponentId (# Word#
a, Maybe Entity
b #)) ((ComponentId (# Word#
x, Maybe Entity
y #))) =
    case Word# -> Word# -> Ordering
compareWord# Word#
a Word#
x of
      Ordering
EQ -> Maybe Entity -> Maybe Entity -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe Entity
b Maybe Entity
y
      Ordering
x -> Ordering
x

-- { -- | The component's entity.
--   id :: Entity,
--   -- | Optional target entity in case this is a pair / relationship.
--   entity :: Maybe Entity
-- }
-- deriving (Show, Eq, Ord)

isPair :: ComponentId -> Bool
isPair :: ComponentId -> Bool
isPair (ComponentId (# Word#
_, Just Entity
_ #)) = Bool
True
isPair ComponentId
_ = Bool
False

setCompIdTarget :: Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget :: Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget Maybe Entity
Nothing (ComponentId (# Word#
a, Maybe Entity
_ #)) = (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
a, Maybe Entity
forall a. Maybe a
Nothing #)
setCompIdTarget (Just Entity
e) (ComponentId (# Word#
a, Maybe Entity
_ #)) = (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
a, Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e #)

newtype Pair = Pair (ComponentType, Entity)

type HashMap k v = H.BasicHashTable k v

-- | Contains data and methods for assigning 'ComponentId's to new components (via their 'TypeRep').
newtype Components = Components
  { -- | Maps 'TypeRep's to Ints, to be used as the first half of a 'ComponentId'.
    Components -> HashMap TypeRep Word
components :: HashMap TypeRep Word
  }

-- | @Meta@ component with a set of all archetypes that a components is part of.
newtype ComponentArchetypes = ComponentArchetypes {ComponentArchetypes -> Set ArchetypeId
inner :: Set ArchetypeId}
  deriving anyclass (Typeable ComponentArchetypes
[HookRel ComponentArchetypes]
[Hook ComponentArchetypes]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ComponentArchetypes)
(Typeable ComponentArchetypes,
 IsExclusive (IsExclusiveRel ComponentArchetypes)) =>
Set DefaultComponentType
-> [Hook ComponentArchetypes]
-> [Hook ComponentArchetypes]
-> [Hook ComponentArchetypes]
-> [HookRel ComponentArchetypes]
-> [HookRel ComponentArchetypes]
-> [HookRel ComponentArchetypes]
-> Component ComponentArchetypes
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook ComponentArchetypes]
onAdd :: [Hook ComponentArchetypes]
$conSet :: [Hook ComponentArchetypes]
onSet :: [Hook ComponentArchetypes]
$conRemove :: [Hook ComponentArchetypes]
onRemove :: [Hook ComponentArchetypes]
$conAddRel :: [HookRel ComponentArchetypes]
onAddRel :: [HookRel ComponentArchetypes]
$conSetRel :: [HookRel ComponentArchetypes]
onSetRel :: [HookRel ComponentArchetypes]
$conRemoveRel :: [HookRel ComponentArchetypes]
onRemoveRel :: [HookRel ComponentArchetypes]
Component)
  deriving newtype (ComponentArchetypes
ComponentArchetypes -> Default ComponentArchetypes
forall a. a -> Default a
$cdef :: ComponentArchetypes
def :: ComponentArchetypes
Default)
  deriving stock (Int -> ComponentArchetypes -> ShowS
[ComponentArchetypes] -> ShowS
ComponentArchetypes -> String
(Int -> ComponentArchetypes -> ShowS)
-> (ComponentArchetypes -> String)
-> ([ComponentArchetypes] -> ShowS)
-> Show ComponentArchetypes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentArchetypes -> ShowS
showsPrec :: Int -> ComponentArchetypes -> ShowS
$cshow :: ComponentArchetypes -> String
show :: ComponentArchetypes -> String
$cshowList :: [ComponentArchetypes] -> ShowS
showList :: [ComponentArchetypes] -> ShowS
Show)

-- | @Meta@ component with a set of all archetypes containing pairs made with this component.
data ComponentPairs = ComponentPairs
  { -- | Archetypes that contain any pair formed with this component.
    ComponentPairs -> Set ArchetypeId
any :: Set ArchetypeId,
    -- | Specific archetypes between this component and a particular entity.
    ComponentPairs -> Map Entity (Set ArchetypeId)
pairs :: Map Entity (Set ArchetypeId)
  }
  deriving anyclass (Typeable ComponentPairs
[HookRel ComponentPairs]
[Hook ComponentPairs]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ComponentPairs)
(Typeable ComponentPairs,
 IsExclusive (IsExclusiveRel ComponentPairs)) =>
Set DefaultComponentType
-> [Hook ComponentPairs]
-> [Hook ComponentPairs]
-> [Hook ComponentPairs]
-> [HookRel ComponentPairs]
-> [HookRel ComponentPairs]
-> [HookRel ComponentPairs]
-> Component ComponentPairs
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook ComponentPairs]
onAdd :: [Hook ComponentPairs]
$conSet :: [Hook ComponentPairs]
onSet :: [Hook ComponentPairs]
$conRemove :: [Hook ComponentPairs]
onRemove :: [Hook ComponentPairs]
$conAddRel :: [HookRel ComponentPairs]
onAddRel :: [HookRel ComponentPairs]
$conSetRel :: [HookRel ComponentPairs]
onSetRel :: [HookRel ComponentPairs]
$conRemoveRel :: [HookRel ComponentPairs]
onRemoveRel :: [HookRel ComponentPairs]
Component, ComponentPairs
ComponentPairs -> Default ComponentPairs
forall a. a -> Default a
$cdef :: ComponentPairs
def :: ComponentPairs
Default)
  deriving stock (Int -> ComponentPairs -> ShowS
[ComponentPairs] -> ShowS
ComponentPairs -> String
(Int -> ComponentPairs -> ShowS)
-> (ComponentPairs -> String)
-> ([ComponentPairs] -> ShowS)
-> Show ComponentPairs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentPairs -> ShowS
showsPrec :: Int -> ComponentPairs -> ShowS
$cshow :: ComponentPairs -> String
show :: ComponentPairs -> String
$cshowList :: [ComponentPairs] -> ShowS
showList :: [ComponentPairs] -> ShowS
Show, (forall x. ComponentPairs -> Rep ComponentPairs x)
-> (forall x. Rep ComponentPairs x -> ComponentPairs)
-> Generic ComponentPairs
forall x. Rep ComponentPairs x -> ComponentPairs
forall x. ComponentPairs -> Rep ComponentPairs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComponentPairs -> Rep ComponentPairs x
from :: forall x. ComponentPairs -> Rep ComponentPairs x
$cto :: forall x. Rep ComponentPairs x -> ComponentPairs
to :: forall x. Rep ComponentPairs x -> ComponentPairs
Generic)

-- | Construct an empty 'Components'.
emptyComponents :: IO Components
emptyComponents :: IO Components
emptyComponents = HashTable RealWorld TypeRep Word -> Components
HashMap TypeRep Word -> Components
Components (HashTable RealWorld TypeRep Word -> Components)
-> IO (HashTable RealWorld TypeRep Word) -> IO Components
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (HashTable RealWorld TypeRep Word)
IO (HashMap TypeRep Word)
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new

-- | Get the id of a component through IO.
getComponentId :: TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId :: TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
t Components {HashMap TypeRep Word
components :: Components -> HashMap TypeRep Word
components :: HashMap TypeRep Word
components} = do
  comp <- HashMap TypeRep Word -> TypeRep -> IO (Maybe Word)
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup HashMap TypeRep Word
components TypeRep
t
  return $ case comp of
    Maybe Word
Nothing -> Maybe ComponentId
forall a. Maybe a
Nothing
    Just (W# Word#
t) -> ComponentId -> Maybe ComponentId
forall a. a -> Maybe a
Just (ComponentId -> Maybe ComponentId)
-> ComponentId -> Maybe ComponentId
forall a b. (a -> b) -> a -> b
$ (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
t, Maybe Entity
forall a. Maybe a
Nothing #)

-- | Try to get the inner data of a 'ErasedComponent'.
tryGetComponent :: forall c. (Component c) => ErasedComponent -> Maybe c
tryGetComponent :: forall c. Component c => ErasedComponent -> Maybe c
tryGetComponent (ErasedComponent (c
s :: c')) =
  case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @c @c' of
    Just c :~: c
Refl -> c -> Maybe c
forall a. a -> Maybe a
Just c
c
s
    Maybe (c :~: c)
Nothing -> Maybe c
forall a. Maybe a
Nothing

instance {-# OVERLAPPING #-} EraseIntoStorage () (BundleData ErasedComponent) where
  erase :: () -> BundleData ErasedComponent
erase ()
_ = Set (BundleElement ErasedComponent)
-> Set (BundleElement ErasedComponent)
-> Set (Entity, BundleData ErasedComponent)
-> BundleData ErasedComponent
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty Set (Entity, BundleData ErasedComponent)
forall a. Set a
Set.empty

instance {-# OVERLAPPING #-} EraseIntoStorage (BundleData ErasedComponent) (BundleData ErasedComponent) where
  erase :: BundleData ErasedComponent -> BundleData ErasedComponent
erase = BundleData ErasedComponent -> BundleData ErasedComponent
forall a. a -> a
id

instance (Component c) => EraseIntoStorage c (BundleData ErasedComponent) where
  erase :: c -> BundleData ErasedComponent
erase c
c =
    Set (BundleElement ErasedComponent)
-> Set (BundleElement ErasedComponent)
-> Set (Entity, BundleData ErasedComponent)
-> BundleData ErasedComponent
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData (BundleElement ErasedComponent
-> Set (BundleElement ErasedComponent)
forall a. a -> Set a
Set.singleton BundleElement {rep :: ComponentRep
rep = ComponentType -> ComponentRep
ComponentRep (ComponentType -> ComponentRep) -> ComponentType -> ComponentRep
forall a b. (a -> b) -> a -> b
$ Proxy c -> ComponentType
forall c. Component c => Proxy c -> ComponentType
ComponentType (Proxy c -> ComponentType) -> Proxy c -> ComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, component :: ErasedComponent
component = c -> ErasedComponent
forall c. Component c => c -> ErasedComponent
ErasedComponent c
c}) Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty Set (Entity, BundleData ErasedComponent)
forall a. Set a
Set.empty

instance {-# OVERLAPPING #-} (Component c) => EraseIntoStorage (Rel c) (BundleData ErasedComponent) where
  erase :: Rel c -> BundleData ErasedComponent
erase (Rel c
c Entity
entity) =
    Set (BundleElement ErasedComponent)
-> Set (BundleElement ErasedComponent)
-> Set (Entity, BundleData ErasedComponent)
-> BundleData ErasedComponent
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData (BundleElement ErasedComponent
-> Set (BundleElement ErasedComponent)
forall a. a -> Set a
Set.singleton BundleElement {rep :: ComponentRep
rep = (ComponentType, Entity) -> ComponentRep
PairRep (Proxy c -> ComponentType
forall c. Component c => Proxy c -> ComponentType
ComponentType (Proxy c -> ComponentType) -> Proxy c -> ComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, Entity
entity), component :: ErasedComponent
component = c -> ErasedComponent
forall c. Component c => c -> ErasedComponent
ErasedComponent c
c}) Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty Set (Entity, BundleData ErasedComponent)
forall a. Set a
Set.empty

instance {-# OVERLAPPING #-} (Component c) => EraseIntoStorage (Res c) (BundleData ErasedComponent) where
  erase :: Res c -> BundleData ErasedComponent
erase (Res c
c) = Set (BundleElement ErasedComponent)
-> Set (BundleElement ErasedComponent)
-> Set (Entity, BundleData ErasedComponent)
-> BundleData ErasedComponent
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty (BundleElement ErasedComponent
-> Set (BundleElement ErasedComponent)
forall a. a -> Set a
Set.singleton BundleElement {rep :: ComponentRep
rep = ComponentType -> ComponentRep
ComponentRep (ComponentType -> ComponentRep) -> ComponentType -> ComponentRep
forall a b. (a -> b) -> a -> b
$ Proxy c -> ComponentType
forall c. Component c => Proxy c -> ComponentType
ComponentType (Proxy c -> ComponentType) -> Proxy c -> ComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, component :: ErasedComponent
component = c -> ErasedComponent
forall c. Component c => c -> ErasedComponent
ErasedComponent c
c}) Set (Entity, BundleData ErasedComponent)
forall a. Set a
Set.empty

instance {-# OVERLAPPING #-} (Collectable c (BundleData ErasedComponent)) => EraseIntoStorage (From c) (BundleData ErasedComponent) where
  erase :: From c -> BundleData ErasedComponent
erase (From Entity
e c
c) = Set (BundleElement ErasedComponent)
-> Set (BundleElement ErasedComponent)
-> Set (Entity, BundleData ErasedComponent)
-> BundleData ErasedComponent
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty ((Entity, BundleData ErasedComponent)
-> Set (Entity, BundleData ErasedComponent)
forall a. a -> Set a
Set.singleton (Entity
e, c -> BundleData ErasedComponent
forall v storage. Collectable v storage => v -> storage
collect c
c))

instance {-# OVERLAPPING #-} (Collectable c (BundleData ErasedComponent)) => EraseIntoStorage [c] (BundleData ErasedComponent) where
  erase :: [c] -> BundleData ErasedComponent
erase = (c -> BundleData ErasedComponent -> BundleData ErasedComponent)
-> BundleData ErasedComponent -> [c] -> BundleData ErasedComponent
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BundleData ErasedComponent
-> BundleData ErasedComponent -> BundleData ErasedComponent
forall a. Semigroup a => a -> a -> a
(<>) (BundleData ErasedComponent
 -> BundleData ErasedComponent -> BundleData ErasedComponent)
-> (c -> BundleData ErasedComponent)
-> c
-> BundleData ErasedComponent
-> BundleData ErasedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> BundleData ErasedComponent
forall v storage. Collectable v storage => v -> storage
collect) (Set (BundleElement ErasedComponent)
-> Set (BundleElement ErasedComponent)
-> Set (Entity, BundleData ErasedComponent)
-> BundleData ErasedComponent
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty Set (BundleElement ErasedComponent)
forall a. Set a
Set.empty Set (Entity, BundleData ErasedComponent)
forall a. Set a
Set.empty)

instance (Component c, Eq c) => EraseIntoStorage c (BundleData ErasedComponentEq) where
  erase :: c -> BundleData ErasedComponentEq
erase c
c =
    Set (BundleElement ErasedComponentEq)
-> Set (BundleElement ErasedComponentEq)
-> Set (Entity, BundleData ErasedComponentEq)
-> BundleData ErasedComponentEq
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData (BundleElement ErasedComponentEq
-> Set (BundleElement ErasedComponentEq)
forall a. a -> Set a
Set.singleton BundleElement {rep :: ComponentRep
rep = ComponentType -> ComponentRep
ComponentRep (ComponentType -> ComponentRep) -> ComponentType -> ComponentRep
forall a b. (a -> b) -> a -> b
$ Proxy c -> ComponentType
forall c. Component c => Proxy c -> ComponentType
ComponentType (Proxy c -> ComponentType) -> Proxy c -> ComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, component :: ErasedComponentEq
component = c -> ErasedComponentEq
forall c. (Component c, Eq c) => c -> ErasedComponentEq
ErasedComponentEq c
c}) Set (BundleElement ErasedComponentEq)
forall a. Set a
Set.empty Set (Entity, BundleData ErasedComponentEq)
forall a. Set a
Set.empty

instance {-# OVERLAPPING #-} (Component c, Eq c) => EraseIntoStorage (Rel c) (BundleData ErasedComponentEq) where
  erase :: Rel c -> BundleData ErasedComponentEq
erase (Rel c
c Entity
entity) =
    Set (BundleElement ErasedComponentEq)
-> Set (BundleElement ErasedComponentEq)
-> Set (Entity, BundleData ErasedComponentEq)
-> BundleData ErasedComponentEq
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData (BundleElement ErasedComponentEq
-> Set (BundleElement ErasedComponentEq)
forall a. a -> Set a
Set.singleton BundleElement {rep :: ComponentRep
rep = (ComponentType, Entity) -> ComponentRep
PairRep (Proxy c -> ComponentType
forall c. Component c => Proxy c -> ComponentType
ComponentType (Proxy c -> ComponentType) -> Proxy c -> ComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, Entity
entity), component :: ErasedComponentEq
component = c -> ErasedComponentEq
forall c. (Component c, Eq c) => c -> ErasedComponentEq
ErasedComponentEq c
c}) Set (BundleElement ErasedComponentEq)
forall a. Set a
Set.empty Set (Entity, BundleData ErasedComponentEq)
forall a. Set a
Set.empty

instance {-# OVERLAPPING #-} (Component c, Eq c) => EraseIntoStorage (Res c) (BundleData ErasedComponentEq) where
  erase :: Res c -> BundleData ErasedComponentEq
erase (Res c
c) = Set (BundleElement ErasedComponentEq)
-> Set (BundleElement ErasedComponentEq)
-> Set (Entity, BundleData ErasedComponentEq)
-> BundleData ErasedComponentEq
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData Set (BundleElement ErasedComponentEq)
forall a. Set a
Set.empty (BundleElement ErasedComponentEq
-> Set (BundleElement ErasedComponentEq)
forall a. a -> Set a
Set.singleton BundleElement {rep :: ComponentRep
rep = ComponentType -> ComponentRep
ComponentRep (ComponentType -> ComponentRep) -> ComponentType -> ComponentRep
forall a b. (a -> b) -> a -> b
$ Proxy c -> ComponentType
forall c. Component c => Proxy c -> ComponentType
ComponentType (Proxy c -> ComponentType) -> Proxy c -> ComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c, component :: ErasedComponentEq
component = c -> ErasedComponentEq
forall c. (Component c, Eq c) => c -> ErasedComponentEq
ErasedComponentEq c
c}) Set (Entity, BundleData ErasedComponentEq)
forall a. Set a
Set.empty

instance {-# OVERLAPPING #-} (Collectable c (BundleData ErasedComponentEq)) => EraseIntoStorage (From c) (BundleData ErasedComponentEq) where
  erase :: From c -> BundleData ErasedComponentEq
erase (From Entity
e c
c) = Set (BundleElement ErasedComponentEq)
-> Set (BundleElement ErasedComponentEq)
-> Set (Entity, BundleData ErasedComponentEq)
-> BundleData ErasedComponentEq
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData Set (BundleElement ErasedComponentEq)
forall a. Set a
Set.empty Set (BundleElement ErasedComponentEq)
forall a. Set a
Set.empty ((Entity, BundleData ErasedComponentEq)
-> Set (Entity, BundleData ErasedComponentEq)
forall a. a -> Set a
Set.singleton (Entity
e, c -> BundleData ErasedComponentEq
forall v storage. Collectable v storage => v -> storage
collect c
c))

instance {-# OVERLAPPING #-} (Collectable c (BundleData ErasedComponentEq)) => EraseIntoStorage [c] (BundleData ErasedComponentEq) where
  erase :: [c] -> BundleData ErasedComponentEq
erase = (c -> BundleData ErasedComponentEq -> BundleData ErasedComponentEq)
-> BundleData ErasedComponentEq
-> [c]
-> BundleData ErasedComponentEq
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BundleData ErasedComponentEq
-> BundleData ErasedComponentEq -> BundleData ErasedComponentEq
forall a. Semigroup a => a -> a -> a
(<>) (BundleData ErasedComponentEq
 -> BundleData ErasedComponentEq -> BundleData ErasedComponentEq)
-> (c -> BundleData ErasedComponentEq)
-> c
-> BundleData ErasedComponentEq
-> BundleData ErasedComponentEq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> BundleData ErasedComponentEq
forall v storage. Collectable v storage => v -> storage
collect) (Set (BundleElement ErasedComponentEq)
-> Set (BundleElement ErasedComponentEq)
-> Set (Entity, BundleData ErasedComponentEq)
-> BundleData ErasedComponentEq
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData Set (BundleElement ErasedComponentEq)
forall a. Set a
Set.empty Set (BundleElement ErasedComponentEq)
forall a. Set a
Set.empty Set (Entity, BundleData ErasedComponentEq)
forall a. Set a
Set.empty)

instance {-# OVERLAPPING #-} EraseIntoStorage (BundleData ErasedComponentEq) (BundleData ErasedComponentEq) where
  erase :: BundleData ErasedComponentEq -> BundleData ErasedComponentEq
erase = BundleData ErasedComponentEq -> BundleData ErasedComponentEq
forall a. a -> a
id

-- | Unique id corresponding to an archetype.
newtype ArchetypeId = ArchetypeId
  { ArchetypeId -> Int
id :: Int
  }
  deriving (Int -> ArchetypeId -> ShowS
[ArchetypeId] -> ShowS
ArchetypeId -> String
(Int -> ArchetypeId -> ShowS)
-> (ArchetypeId -> String)
-> ([ArchetypeId] -> ShowS)
-> Show ArchetypeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArchetypeId -> ShowS
showsPrec :: Int -> ArchetypeId -> ShowS
$cshow :: ArchetypeId -> String
show :: ArchetypeId -> String
$cshowList :: [ArchetypeId] -> ShowS
showList :: [ArchetypeId] -> ShowS
Show, ArchetypeId -> ArchetypeId -> Bool
(ArchetypeId -> ArchetypeId -> Bool)
-> (ArchetypeId -> ArchetypeId -> Bool) -> Eq ArchetypeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArchetypeId -> ArchetypeId -> Bool
== :: ArchetypeId -> ArchetypeId -> Bool
$c/= :: ArchetypeId -> ArchetypeId -> Bool
/= :: ArchetypeId -> ArchetypeId -> Bool
Eq, Eq ArchetypeId
Eq ArchetypeId =>
(ArchetypeId -> ArchetypeId -> Ordering)
-> (ArchetypeId -> ArchetypeId -> Bool)
-> (ArchetypeId -> ArchetypeId -> Bool)
-> (ArchetypeId -> ArchetypeId -> Bool)
-> (ArchetypeId -> ArchetypeId -> Bool)
-> (ArchetypeId -> ArchetypeId -> ArchetypeId)
-> (ArchetypeId -> ArchetypeId -> ArchetypeId)
-> Ord ArchetypeId
ArchetypeId -> ArchetypeId -> Bool
ArchetypeId -> ArchetypeId -> Ordering
ArchetypeId -> ArchetypeId -> ArchetypeId
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 :: ArchetypeId -> ArchetypeId -> Ordering
compare :: ArchetypeId -> ArchetypeId -> Ordering
$c< :: ArchetypeId -> ArchetypeId -> Bool
< :: ArchetypeId -> ArchetypeId -> Bool
$c<= :: ArchetypeId -> ArchetypeId -> Bool
<= :: ArchetypeId -> ArchetypeId -> Bool
$c> :: ArchetypeId -> ArchetypeId -> Bool
> :: ArchetypeId -> ArchetypeId -> Bool
$c>= :: ArchetypeId -> ArchetypeId -> Bool
>= :: ArchetypeId -> ArchetypeId -> Bool
$cmax :: ArchetypeId -> ArchetypeId -> ArchetypeId
max :: ArchetypeId -> ArchetypeId -> ArchetypeId
$cmin :: ArchetypeId -> ArchetypeId -> ArchetypeId
min :: ArchetypeId -> ArchetypeId -> ArchetypeId
Ord)

-- | Data extracted from a 'Mischief.ECS.Components.Bundle.Bundle'.
data BundleData e = BundleData {forall e. BundleData e -> Set (BundleElement e)
elements :: Set (BundleElement e), forall e. BundleData e -> Set (BundleElement e)
resources :: Set (BundleElement e), forall e. BundleData e -> Set (Entity, BundleData e)
external :: Set (Entity, BundleData e)} deriving (BundleData e -> BundleData e -> Bool
(BundleData e -> BundleData e -> Bool)
-> (BundleData e -> BundleData e -> Bool) -> Eq (BundleData e)
forall e. BundleData e -> BundleData e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. BundleData e -> BundleData e -> Bool
== :: BundleData e -> BundleData e -> Bool
$c/= :: forall e. BundleData e -> BundleData e -> Bool
/= :: BundleData e -> BundleData e -> Bool
Eq, Eq (BundleData e)
Eq (BundleData e) =>
(BundleData e -> BundleData e -> Ordering)
-> (BundleData e -> BundleData e -> Bool)
-> (BundleData e -> BundleData e -> Bool)
-> (BundleData e -> BundleData e -> Bool)
-> (BundleData e -> BundleData e -> Bool)
-> (BundleData e -> BundleData e -> BundleData e)
-> (BundleData e -> BundleData e -> BundleData e)
-> Ord (BundleData e)
BundleData e -> BundleData e -> Bool
BundleData e -> BundleData e -> Ordering
BundleData e -> BundleData e -> BundleData e
forall e. Eq (BundleData e)
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
forall e. BundleData e -> BundleData e -> Bool
forall e. BundleData e -> BundleData e -> Ordering
forall e. BundleData e -> BundleData e -> BundleData e
$ccompare :: forall e. BundleData e -> BundleData e -> Ordering
compare :: BundleData e -> BundleData e -> Ordering
$c< :: forall e. BundleData e -> BundleData e -> Bool
< :: BundleData e -> BundleData e -> Bool
$c<= :: forall e. BundleData e -> BundleData e -> Bool
<= :: BundleData e -> BundleData e -> Bool
$c> :: forall e. BundleData e -> BundleData e -> Bool
> :: BundleData e -> BundleData e -> Bool
$c>= :: forall e. BundleData e -> BundleData e -> Bool
>= :: BundleData e -> BundleData e -> Bool
$cmax :: forall e. BundleData e -> BundleData e -> BundleData e
max :: BundleData e -> BundleData e -> BundleData e
$cmin :: forall e. BundleData e -> BundleData e -> BundleData e
min :: BundleData e -> BundleData e -> BundleData e
Ord)

instance Semigroup (BundleData e) where
  <> :: BundleData e -> BundleData e -> BundleData e
(<>) (BundleData Set (BundleElement e)
a0 Set (BundleElement e)
b0 Set (Entity, BundleData e)
c0) (BundleData Set (BundleElement e)
a1 Set (BundleElement e)
b1 Set (Entity, BundleData e)
c1) = Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
forall e.
Set (BundleElement e)
-> Set (BundleElement e)
-> Set (Entity, BundleData e)
-> BundleData e
BundleData (Set (BundleElement e)
a0 Set (BundleElement e)
-> Set (BundleElement e) -> Set (BundleElement e)
forall a. Semigroup a => a -> a -> a
<> Set (BundleElement e)
a1) (Set (BundleElement e)
b0 Set (BundleElement e)
-> Set (BundleElement e) -> Set (BundleElement e)
forall a. Semigroup a => a -> a -> a
<> Set (BundleElement e)
b1) (Set (Entity, BundleData e)
c0 Set (Entity, BundleData e)
-> Set (Entity, BundleData e) -> Set (Entity, BundleData e)
forall a. Semigroup a => a -> a -> a
<> Set (Entity, BundleData e)
c1)

instance Show (BundleData e) where
  show :: BundleData e -> String
show BundleData {Set (BundleElement e)
elements :: forall e. BundleData e -> Set (BundleElement e)
elements :: Set (BundleElement e)
elements} = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"BundleData e [", String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
ts, String
"]"]
    where
      ts :: [String]
ts = (BundleElement e -> String) -> [BundleElement e] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\BundleElement e
bundle -> ComponentRep -> String
forall a. Show a => a -> String
show BundleElement e
bundle.rep) (Set (BundleElement e) -> [BundleElement e]
forall a. Set a -> [a]
Set.toList Set (BundleElement e)
elements)

-- | Change ticks for a specific component.
data ComponentTicks = ComponentTicks {ComponentTicks -> Tick
changed :: Tick, ComponentTicks -> Tick
added :: Tick} deriving (Int -> ComponentTicks -> ShowS
[ComponentTicks] -> ShowS
ComponentTicks -> String
(Int -> ComponentTicks -> ShowS)
-> (ComponentTicks -> String)
-> ([ComponentTicks] -> ShowS)
-> Show ComponentTicks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentTicks -> ShowS
showsPrec :: Int -> ComponentTicks -> ShowS
$cshow :: ComponentTicks -> String
show :: ComponentTicks -> String
$cshowList :: [ComponentTicks] -> ShowS
showList :: [ComponentTicks] -> ShowS
Show)

-- | Data for a component that's stored in a table.
data ComponentData = ComponentData {ComponentData -> ErasedComponent
value :: ErasedComponent, ComponentData -> ComponentTicks
ticks :: ComponentTicks}

-- | Type used for querying and inserting relationships.
data Rel c = Rel {forall c. Rel c -> c
comp :: c, forall c. Rel c -> Entity
target :: Entity} deriving (Rel c -> Rel c -> Bool
(Rel c -> Rel c -> Bool) -> (Rel c -> Rel c -> Bool) -> Eq (Rel c)
forall c. Eq c => Rel c -> Rel c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Rel c -> Rel c -> Bool
== :: Rel c -> Rel c -> Bool
$c/= :: forall c. Eq c => Rel c -> Rel c -> Bool
/= :: Rel c -> Rel c -> Bool
Eq)

instance Functor Rel where
  fmap :: forall a b. (a -> b) -> Rel a -> Rel b
fmap a -> b
f (Rel a
c Entity
target) = b -> Entity -> Rel b
forall c. c -> Entity -> Rel c
Rel (a -> b
f a
c) Entity
target

instance (Show c) => Show (Rel c) where
  show :: Rel c -> String
show Rel {c
comp :: forall c. Rel c -> c
comp :: c
comp, Entity
target :: forall c. Rel c -> Entity
target :: Entity
target} = String
"Rel (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Show a => a -> String
show c
comp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Entity -> String
forall a. Show a => a -> String
show Entity
target String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

data From c = From {forall c. From c -> Entity
entity :: Entity, forall c. From c -> c
comp :: c} deriving (From c -> From c -> Bool
(From c -> From c -> Bool)
-> (From c -> From c -> Bool) -> Eq (From c)
forall c. Eq c => From c -> From c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => From c -> From c -> Bool
== :: From c -> From c -> Bool
$c/= :: forall c. Eq c => From c -> From c -> Bool
/= :: From c -> From c -> Bool
Eq)

instance Functor From where
  fmap :: (a -> b) -> From a -> From b
  fmap :: forall a b. (a -> b) -> From a -> From b
fmap a -> b
f (From Entity
c a
x) = Entity -> b -> From b
forall c. Entity -> c -> From c
From Entity
c (a -> b
f a
x)

instance (Show c) => Show (From c) where
  show :: From c -> String
show From {Entity
entity :: forall c. From c -> Entity
entity :: Entity
entity, c
comp :: forall c. From c -> c
comp :: c
comp} = String
"From (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Entity -> String
forall a. Show a => a -> String
show Entity
entity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Show a => a -> String
show c
comp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

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

instance Functor Res where
  fmap :: forall a b. (a -> b) -> Res a -> Res b
fmap a -> b
f (Res a
c) = b -> Res b
forall c. c -> Res c
Res (a -> b
f a
c)

-- | @Meta@ component with the /erased/ default value of this component. Added to components required by other components.
newtype DefaultValue = DefaultValue ErasedComponent deriving anyclass (Typeable DefaultValue
[HookRel DefaultValue]
[Hook DefaultValue]
Set DefaultComponentType
IsExclusive (IsExclusiveRel DefaultValue)
(Typeable DefaultValue,
 IsExclusive (IsExclusiveRel DefaultValue)) =>
Set DefaultComponentType
-> [Hook DefaultValue]
-> [Hook DefaultValue]
-> [Hook DefaultValue]
-> [HookRel DefaultValue]
-> [HookRel DefaultValue]
-> [HookRel DefaultValue]
-> Component DefaultValue
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook DefaultValue]
onAdd :: [Hook DefaultValue]
$conSet :: [Hook DefaultValue]
onSet :: [Hook DefaultValue]
$conRemove :: [Hook DefaultValue]
onRemove :: [Hook DefaultValue]
$conAddRel :: [HookRel DefaultValue]
onAddRel :: [HookRel DefaultValue]
$conSetRel :: [HookRel DefaultValue]
onSetRel :: [HookRel DefaultValue]
$conRemoveRel :: [HookRel DefaultValue]
onRemoveRel :: [HookRel DefaultValue]
Component)

instance Component ComponentType where
  required :: Set DefaultComponentType
required = [DefaultComponentType] -> Set DefaultComponentType
forall a. Ord a => [a] -> Set a
Set.fromList [Proxy ComponentArchetypes -> DefaultComponentType
forall c.
(Component c, Default c) =>
Proxy c -> DefaultComponentType
DefaultComponentType (Proxy ComponentArchetypes -> DefaultComponentType)
-> Proxy ComponentArchetypes -> DefaultComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ComponentArchetypes, Proxy ComponentPairs -> DefaultComponentType
forall c.
(Component c, Default c) =>
Proxy c -> DefaultComponentType
DefaultComponentType (Proxy ComponentPairs -> DefaultComponentType)
-> Proxy ComponentPairs -> DefaultComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ComponentPairs]

-- | @Meta@ relationship.
data RequiredBy = RequiredBy deriving (Typeable RequiredBy
[HookRel RequiredBy]
[Hook RequiredBy]
Set DefaultComponentType
IsExclusive (IsExclusiveRel RequiredBy)
(Typeable RequiredBy, IsExclusive (IsExclusiveRel RequiredBy)) =>
Set DefaultComponentType
-> [Hook RequiredBy]
-> [Hook RequiredBy]
-> [Hook RequiredBy]
-> [HookRel RequiredBy]
-> [HookRel RequiredBy]
-> [HookRel RequiredBy]
-> Component RequiredBy
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook RequiredBy]
onAdd :: [Hook RequiredBy]
$conSet :: [Hook RequiredBy]
onSet :: [Hook RequiredBy]
$conRemove :: [Hook RequiredBy]
onRemove :: [Hook RequiredBy]
$conAddRel :: [HookRel RequiredBy]
onAddRel :: [HookRel RequiredBy]
$conSetRel :: [HookRel RequiredBy]
onSetRel :: [HookRel RequiredBy]
$conRemoveRel :: [HookRel RequiredBy]
onRemoveRel :: [HookRel RequiredBy]
Component)

-- | @Meta@ relationship.
data Requires = Requires deriving (Typeable Requires
[HookRel Requires]
[Hook Requires]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Requires)
(Typeable Requires, IsExclusive (IsExclusiveRel Requires)) =>
Set DefaultComponentType
-> [Hook Requires]
-> [Hook Requires]
-> [Hook Requires]
-> [HookRel Requires]
-> [HookRel Requires]
-> [HookRel Requires]
-> Component Requires
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Requires]
onAdd :: [Hook Requires]
$conSet :: [Hook Requires]
onSet :: [Hook Requires]
$conRemove :: [Hook Requires]
onRemove :: [Hook Requires]
$conAddRel :: [HookRel Requires]
onAddRel :: [HookRel Requires]
$conSetRel :: [HookRel Requires]
onSetRel :: [HookRel Requires]
$conRemoveRel :: [HookRel Requires]
onRemoveRel :: [HookRel Requires]
Component)

-- | Type for component erasure.
data ErasedComponent where
  ErasedComponent :: (Component c) => c -> ErasedComponent

data ErasedComponentEq where
  ErasedComponentEq :: (Component c, Eq c) => c -> ErasedComponentEq

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

-- | Element of a 'BundleData e'.
data BundleElement e = BundleElement {forall e. BundleElement e -> ComponentRep
rep :: ComponentRep, forall e. BundleElement e -> e
component :: e}

instance Show (BundleElement a) where
  show :: BundleElement a -> String
  show :: BundleElement a -> String
show BundleElement a
e = ComponentRep -> String
forall a. Show a => a -> String
show BundleElement a
e.rep

instance Eq (BundleElement a) where
  (==) :: BundleElement a -> BundleElement a -> Bool
  == :: BundleElement a -> BundleElement a -> Bool
(==) BundleElement {rep :: forall e. BundleElement e -> ComponentRep
rep = ComponentRep
rep1} BundleElement {rep :: forall e. BundleElement e -> ComponentRep
rep = ComponentRep
rep2} = ComponentRep
rep1 ComponentRep -> ComponentRep -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentRep
rep2

instance Ord (BundleElement a) where
  compare :: BundleElement a -> BundleElement a -> Ordering
  compare :: BundleElement a -> BundleElement a -> Ordering
compare BundleElement {rep :: forall e. BundleElement e -> ComponentRep
rep = ComponentRep
rep1} BundleElement {rep :: forall e. BundleElement e -> ComponentRep
rep = ComponentRep
rep2} = ComponentRep -> ComponentRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ComponentRep
rep1 ComponentRep
rep2

-- @Meta@ component containing the erased type of this component.
data ComponentType where
  ComponentType :: forall (c :: Type). (Component c) => (Proxy c) -> ComponentType

instance Show ComponentType where
  show :: ComponentType -> String
  show :: ComponentType -> String
show ComponentType
x = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ ComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep ComponentType
x

instance Eq ComponentType where
  (==) :: ComponentType -> ComponentType -> Bool
  == :: ComponentType -> ComponentType -> Bool
(==) ComponentType
a ComponentType
b = ComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep ComponentType
a TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep ComponentType
b

instance Ord ComponentType where
  compare :: ComponentType -> ComponentType -> Ordering
  compare :: ComponentType -> ComponentType -> Ordering
compare ComponentType
a ComponentType
b = TypeRep -> TypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep ComponentType
a) (ComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep ComponentType
b)

data DefaultComponentType where
  DefaultComponentType :: forall (c :: Type). (Component c, Default c) => (Proxy c) -> DefaultComponentType

instance Show DefaultComponentType where
  show :: DefaultComponentType -> String
  show :: DefaultComponentType -> String
show DefaultComponentType
x = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ DefaultComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep DefaultComponentType
x

instance Eq DefaultComponentType where
  (==) :: DefaultComponentType -> DefaultComponentType -> Bool
  == :: DefaultComponentType -> DefaultComponentType -> Bool
(==) DefaultComponentType
a DefaultComponentType
b = DefaultComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep DefaultComponentType
a TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== DefaultComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep DefaultComponentType
b

instance Ord DefaultComponentType where
  compare :: DefaultComponentType -> DefaultComponentType -> Ordering
  compare :: DefaultComponentType -> DefaultComponentType -> Ordering
compare DefaultComponentType
a DefaultComponentType
b = TypeRep -> TypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (DefaultComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep DefaultComponentType
a) (DefaultComponentType -> TypeRep
forall t. GetRep t => t -> TypeRep
getRep DefaultComponentType
b)

instance GetRep ComponentType where
  getRep :: ComponentType -> TypeRep
  getRep :: ComponentType -> TypeRep
getRep (ComponentType (Proxy c
_ :: (Proxy t))) = Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t

instance GetRep ErasedComponent where
  getRep :: ErasedComponent -> TypeRep
  getRep :: ErasedComponent -> TypeRep
getRep (ErasedComponent (c
_ :: c)) = Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c

instance GetRep DefaultComponentType where
  getRep :: DefaultComponentType -> TypeRep
  getRep :: DefaultComponentType -> TypeRep
getRep (DefaultComponentType (Proxy c
_ :: (Proxy t))) = Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t

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

data IsExclusiveRelationship = IsExclusiveRelationship deriving (Int -> IsExclusiveRelationship -> ShowS
[IsExclusiveRelationship] -> ShowS
IsExclusiveRelationship -> String
(Int -> IsExclusiveRelationship -> ShowS)
-> (IsExclusiveRelationship -> String)
-> ([IsExclusiveRelationship] -> ShowS)
-> Show IsExclusiveRelationship
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsExclusiveRelationship -> ShowS
showsPrec :: Int -> IsExclusiveRelationship -> ShowS
$cshow :: IsExclusiveRelationship -> String
show :: IsExclusiveRelationship -> String
$cshowList :: [IsExclusiveRelationship] -> ShowS
showList :: [IsExclusiveRelationship] -> ShowS
Show, Typeable IsExclusiveRelationship
[HookRel IsExclusiveRelationship]
[Hook IsExclusiveRelationship]
Set DefaultComponentType
IsExclusive (IsExclusiveRel IsExclusiveRelationship)
(Typeable IsExclusiveRelationship,
 IsExclusive (IsExclusiveRel IsExclusiveRelationship)) =>
Set DefaultComponentType
-> [Hook IsExclusiveRelationship]
-> [Hook IsExclusiveRelationship]
-> [Hook IsExclusiveRelationship]
-> [HookRel IsExclusiveRelationship]
-> [HookRel IsExclusiveRelationship]
-> [HookRel IsExclusiveRelationship]
-> Component IsExclusiveRelationship
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook IsExclusiveRelationship]
onAdd :: [Hook IsExclusiveRelationship]
$conSet :: [Hook IsExclusiveRelationship]
onSet :: [Hook IsExclusiveRelationship]
$conRemove :: [Hook IsExclusiveRelationship]
onRemove :: [Hook IsExclusiveRelationship]
$conAddRel :: [HookRel IsExclusiveRelationship]
onAddRel :: [HookRel IsExclusiveRelationship]
$conSetRel :: [HookRel IsExclusiveRelationship]
onSetRel :: [HookRel IsExclusiveRelationship]
$conRemoveRel :: [HookRel IsExclusiveRelationship]
onRemoveRel :: [HookRel IsExclusiveRelationship]
Component)