{-# 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 (..),
    ComponentRep (..),
    Tick (..),
    ErasedComponentEq (..),
    IsExclusive (..),
    isPair,
    setCompIdTarget,
  )
where

import Data.Default
import Data.HashTable.IO qualified as H
import Data.IORef
import Data.Kind
import Data.List qualified as List
import Data.Map (Map)
import Data.Map qualified as 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 (RelExclusivity 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 RelExclusivity c :: Exclusivity
  type RelExclusivity c = Inclusive

  hooks :: Hooks c
  hooks = [ErasedHook c] -> Hooks c
forall {k} (c :: k). [ErasedHook c] -> Hooks c
Hooks []

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

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

instance IsExclusive Exclusive 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
Set DefaultComponentType
Hooks ComponentArchetypes
IsExclusive (RelExclusivity ComponentArchetypes)
(Typeable ComponentArchetypes,
 IsExclusive (RelExclusivity ComponentArchetypes)) =>
Set DefaultComponentType
-> Hooks ComponentArchetypes -> Component ComponentArchetypes
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks ComponentArchetypes
hooks :: Hooks 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
Set DefaultComponentType
Hooks ComponentPairs
IsExclusive (RelExclusivity ComponentPairs)
(Typeable ComponentPairs,
 IsExclusive (RelExclusivity ComponentPairs)) =>
Set DefaultComponentType
-> Hooks ComponentPairs -> Component ComponentPairs
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks ComponentPairs
hooks :: Hooks 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) -> BundleData ErasedComponent
forall e. Set (BundleElement e) -> BundleData e
BundleData Set (BundleElement 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) -> BundleData ErasedComponent
forall e. Set (BundleElement e) -> BundleData e
BundleData (Set (BundleElement ErasedComponent) -> BundleData ErasedComponent)
-> Set (BundleElement ErasedComponent)
-> BundleData ErasedComponent
forall a b. (a -> b) -> a -> b
$ 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}

instance {-# OVERLAPPING #-} (Component c) => EraseIntoStorage (Rel c) (BundleData ErasedComponent) where
  erase :: Rel c -> BundleData ErasedComponent
erase (Rel c
c Entity
entity) =
    Set (BundleElement ErasedComponent) -> BundleData ErasedComponent
forall e. Set (BundleElement e) -> BundleData e
BundleData (Set (BundleElement ErasedComponent) -> BundleData ErasedComponent)
-> Set (BundleElement ErasedComponent)
-> BundleData ErasedComponent
forall a b. (a -> b) -> a -> b
$ 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}

instance (Component c, Eq c) => EraseIntoStorage c (BundleData ErasedComponentEq) where
  erase :: c -> BundleData ErasedComponentEq
erase c
c =
    Set (BundleElement ErasedComponentEq)
-> BundleData ErasedComponentEq
forall e. Set (BundleElement e) -> BundleData e
BundleData (Set (BundleElement ErasedComponentEq)
 -> BundleData ErasedComponentEq)
-> Set (BundleElement ErasedComponentEq)
-> BundleData ErasedComponentEq
forall a b. (a -> b) -> a -> b
$ 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}

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)
-> BundleData ErasedComponentEq
forall e. Set (BundleElement e) -> BundleData e
BundleData (Set (BundleElement ErasedComponentEq)
 -> BundleData ErasedComponentEq)
-> Set (BundleElement ErasedComponentEq)
-> BundleData ErasedComponentEq
forall a b. (a -> b) -> a -> b
$ 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}

-- | 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'.
newtype BundleData e = BundleData {forall e. BundleData e -> Set (BundleElement e)
elements :: Set (BundleElement e)} deriving newtype (NonEmpty (BundleData e) -> BundleData e
BundleData e -> BundleData e -> BundleData e
(BundleData e -> BundleData e -> BundleData e)
-> (NonEmpty (BundleData e) -> BundleData e)
-> (forall b. Integral b => b -> BundleData e -> BundleData e)
-> Semigroup (BundleData e)
forall b. Integral b => b -> BundleData e -> BundleData e
forall e. NonEmpty (BundleData e) -> BundleData e
forall e. BundleData e -> BundleData e -> BundleData e
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall e b. Integral b => b -> BundleData e -> BundleData e
$c<> :: forall e. BundleData e -> BundleData e -> BundleData e
<> :: BundleData e -> BundleData e -> BundleData e
$csconcat :: forall e. NonEmpty (BundleData e) -> BundleData e
sconcat :: NonEmpty (BundleData e) -> BundleData e
$cstimes :: forall e b. Integral b => b -> BundleData e -> BundleData e
stimes :: forall b. Integral b => b -> BundleData e -> BundleData e
Semigroup)

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 (Int -> Rel c -> ShowS
[Rel c] -> ShowS
Rel c -> String
(Int -> Rel c -> ShowS)
-> (Rel c -> String) -> ([Rel c] -> ShowS) -> Show (Rel c)
forall c. Show c => Int -> Rel c -> ShowS
forall c. Show c => [Rel c] -> ShowS
forall c. Show c => Rel c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> Rel c -> ShowS
showsPrec :: Int -> Rel c -> ShowS
$cshow :: forall c. Show c => Rel c -> String
show :: Rel c -> String
$cshowList :: forall c. Show c => [Rel c] -> ShowS
showList :: [Rel c] -> ShowS
Show)

-- | @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
Set DefaultComponentType
Hooks DefaultValue
IsExclusive (RelExclusivity DefaultValue)
(Typeable DefaultValue,
 IsExclusive (RelExclusivity DefaultValue)) =>
Set DefaultComponentType
-> Hooks DefaultValue -> Component DefaultValue
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks DefaultValue
hooks :: Hooks 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
Set DefaultComponentType
Hooks RequiredBy
IsExclusive (RelExclusivity RequiredBy)
(Typeable RequiredBy, IsExclusive (RelExclusivity RequiredBy)) =>
Set DefaultComponentType
-> Hooks RequiredBy -> Component RequiredBy
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks RequiredBy
hooks :: Hooks RequiredBy
Component)

-- | @Meta@ relationship.
data Requires = Requires deriving (Typeable Requires
Set DefaultComponentType
Hooks Requires
IsExclusive (RelExclusivity Requires)
(Typeable Requires, IsExclusive (RelExclusivity Requires)) =>
Set DefaultComponentType -> Hooks Requires -> Component Requires
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks Requires
hooks :: Hooks 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)