{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.Components.Spawn where

import Control.Monad
import Control.Monad.IO.Class
import Data.Data
import Data.Default
import Data.Foldable
-- import Mischief.ECS.Components.Hooks
-- import Mischief.ECS.World.Defer
-- import Mischief.ECS.World.Insert

-- import Mischief.ECS.Events

import Data.HashTable.IO qualified as H
import GHC.Base (Word (..))
import Mischief.ECS.Components
import Mischief.ECS.Components.Common
import Mischief.ECS.Components.HooksDef
import Mischief.ECS.Components.Required (requireAll)
import Mischief.ECS.Entities
import Mischief.ECS.World
import Mischief.ECS.World.Prefs

-- import Mischief.ECS.World.Spawn

-- | Get the id of a component - entity pair. In case the component isn't registered, it will give it a new id.
getOrAddPairId :: Pair -> System ComponentId
getOrAddPairId :: Pair -> System ComponentId
getOrAddPairId (Pair (ComponentType
t, Entity
entity)) = do
  (ComponentId (# id, _ #)) <- ComponentType -> System ComponentId
getOrAddComponentId ComponentType
t
  return $ ComponentId (# id, Just entity #)

-- | Get the id of a component. In case the component isn't registered, it will give it a new id.
getOrAddComponentId :: ComponentType -> System ComponentId
getOrAddComponentId :: ComponentType -> System ComponentId
getOrAddComponentId (ComponentType (Proxy c
_ :: Proxy c)) = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let comp = World
world.components
  w <- liftIO $ H.lookup comp.components (typeRep $ Proxy @c)

  case w of
    Just (W# Word#
t) -> ComponentId -> System ComponentId
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentId -> System ComponentId)
-> ComponentId -> System ComponentId
forall a b. (a -> b) -> a -> b
$ (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
t, Maybe Entity
forall a. Maybe a
Nothing #)
    Maybe Word
Nothing -> do
      result <- IO Entity -> System Entity
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Entity -> System Entity) -> IO Entity -> System Entity
forall a b. (a -> b) -> a -> b
$ Entities -> IO Entity
getNewEntityComp World
world.entities
      let !(Entity (# id, _ #)) = result

      liftIO $ H.insert comp.components (typeRep $ Proxy @c) (W# id)
      -- liftIO $ modifyIORef' comp.components $ Map.insert (typeRep $ Proxy @c) (W# id)

      -- l <- liftIO $ newIORef Set.empty
      -- liftIO $ modifyIORef' comp.archetypes $ Map.insert result l

      forkPrefs (supressEvents True) $
        worldSpawnByInsert
          result
          ( ( ComponentType $ Proxy @c,
              ( def @ComponentArchetypes,
                def @ComponentPairs
              )
            ),
            Name $
              "Meta entity for " ++ show (typeRep $ Proxy @c)
          )

      when (isExclusive @(IsExclusiveRel c)) $ do
        worldSet IsExclusiveRelationship result

      for_ (requireAll @c) $ \(DefaultComponentType (Proxy c
_ :: (Proxy other))) -> do
        (ComponentId (# otherId', _ #)) <- ComponentType -> System ComponentId
getOrAddComponentId (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 @other)

        let otherId = (# Word#, Word# #) -> Entity
Entity (# Word#
otherId', Word#
0## #)
        worldSet (Rel RequiredBy result) otherId
        worldSet (Rel Requires otherId) result
        worldSet (DefaultValue $ ErasedComponent $ def @other) otherId

      registerHooks @c result

      return $ ComponentId (# id, Nothing #)

-- l <- liftIO $ newIORef Set.empty
-- liftIO $ modifyIORef' archetypes $ Map.insert id l

meta :: forall c. (Component c) => System Entity
meta :: forall c. Component c => System Entity
meta = do
  (ComponentId (# id, _ #)) <- ComponentType -> System ComponentId
getOrAddComponentId (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)
  return $ Entity (# id, 0## #)

tryMeta :: forall c m w. (Component c, MonadSystem w m) => m (Maybe Entity)
tryMeta :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
m (Maybe Entity)
tryMeta = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  component <- liftIO $ getComponentId (typeRep $ Proxy @c) world.components
  return $ fmap (\(ComponentId (# Word#
id, Maybe Entity
_ #)) -> (# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #)) component

registerHooks :: forall c. (Component c) => Entity -> System ()
registerHooks :: forall c. Component c => Entity -> System ()
registerHooks Entity
entity = do
  let a :: [HookContext -> System ()]
a = (Hook c -> HookContext -> System ())
-> [Hook c] -> [HookContext -> System ()]
forall a b. (a -> b) -> [a] -> [b]
map Hook c -> HookContext -> System ()
forall {k} (c :: k). Hook c -> HookContext -> System ()
getHook (forall c. Component c => [Hook c]
onAdd @c)
  let s :: [HookContext -> System ()]
s = (Hook c -> HookContext -> System ())
-> [Hook c] -> [HookContext -> System ()]
forall a b. (a -> b) -> [a] -> [b]
map Hook c -> HookContext -> System ()
forall {k} (c :: k). Hook c -> HookContext -> System ()
getHook (forall c. Component c => [Hook c]
onSet @c)
  let r :: [HookContext -> System ()]
r = (Hook c -> HookContext -> System ())
-> [Hook c] -> [HookContext -> System ()]
forall a b. (a -> b) -> [a] -> [b]
map Hook c -> HookContext -> System ()
forall {k} (c :: k). Hook c -> HookContext -> System ()
getHook (forall c. Component c => [Hook c]
onRemove @c)
  let ar :: [HookContextRel -> System ()]
ar = (HookRel c -> HookContextRel -> System ())
-> [HookRel c] -> [HookContextRel -> System ()]
forall a b. (a -> b) -> [a] -> [b]
map HookRel c -> HookContextRel -> System ()
forall {k} (c :: k). HookRel c -> HookContextRel -> System ()
getHookRel (forall c. Component c => [HookRel c]
onAddRel @c)
  let sr :: [HookContextRel -> System ()]
sr = (HookRel c -> HookContextRel -> System ())
-> [HookRel c] -> [HookContextRel -> System ()]
forall a b. (a -> b) -> [a] -> [b]
map HookRel c -> HookContextRel -> System ()
forall {k} (c :: k). HookRel c -> HookContextRel -> System ()
getHookRel (forall c. Component c => [HookRel c]
onSetRel @c)
  let rr :: [HookContextRel -> System ()]
rr = (HookRel c -> HookContextRel -> System ())
-> [HookRel c] -> [HookContextRel -> System ()]
forall a b. (a -> b) -> [a] -> [b]
map HookRel c -> HookContextRel -> System ()
forall {k} (c :: k). HookRel c -> HookContextRel -> System ()
getHookRel (forall c. Component c => [HookRel c]
onRemoveRel @c)

  ComponentAddHooks -> Entity -> System ()
forall c. Bundle c => c -> Entity -> System ()
worldSet ([HookContext -> System ()] -> ComponentAddHooks
ComponentAddHooks [HookContext -> System ()]
a) Entity
entity
  ComponentSetHooks -> Entity -> System ()
forall c. Bundle c => c -> Entity -> System ()
worldSet ([HookContext -> System ()] -> ComponentSetHooks
ComponentSetHooks [HookContext -> System ()]
s) Entity
entity
  ComponentRemoveHooks -> Entity -> System ()
forall c. Bundle c => c -> Entity -> System ()
worldSet ([HookContext -> System ()] -> ComponentRemoveHooks
ComponentRemoveHooks [HookContext -> System ()]
r) Entity
entity
  ComponentAddHooksRel -> Entity -> System ()
forall c. Bundle c => c -> Entity -> System ()
worldSet ([HookContextRel -> System ()] -> ComponentAddHooksRel
ComponentAddHooksRel [HookContextRel -> System ()]
ar) Entity
entity
  ComponentSetHooksRel -> Entity -> System ()
forall c. Bundle c => c -> Entity -> System ()
worldSet ([HookContextRel -> System ()] -> ComponentSetHooksRel
ComponentSetHooksRel [HookContextRel -> System ()]
sr) Entity
entity
  ComponentRemoveHooksRel -> Entity -> System ()
forall c. Bundle c => c -> Entity -> System ()
worldSet ([HookContextRel -> System ()] -> ComponentRemoveHooksRel
ComponentRemoveHooksRel [HookContextRel -> System ()]
rr) Entity
entity

getHook :: Hook c -> (HookContext -> System ())
getHook :: forall {k} (c :: k). Hook c -> HookContext -> System ()
getHook (Hook (HookContext -> m ()
h :: HookContext -> m ())) = do
  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 @m @System of
    Maybe (m :~: System)
Nothing -> HookContext -> System ()
forall a. HasCallStack => a
undefined
    Just m :~: System
Refl -> HookContext -> m ()
HookContext -> System ()
h

getHookRel :: HookRel c -> (HookContextRel -> System ())
getHookRel :: forall {k} (c :: k). HookRel c -> HookContextRel -> System ()
getHookRel (HookRel (HookContextRel -> m ()
h :: HookContextRel -> m ())) = do
  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 @m @System of
    Maybe (m :~: System)
Nothing -> HookContextRel -> System ()
forall a. HasCallStack => a
undefined
    Just m :~: System
Refl -> HookContextRel -> m ()
HookContextRel -> System ()
h

-- registerHook :: ErasedHook c -> System ()
-- registerHook (ErasedHook (h :: e c -> m ())) = do
--   world <- unsafeGetWorld
--   e <- liftIO $ getNewEntity world.entities
--   case eqT @m @System of
--     Just Refl -> void $ worldSpawnByInsert e $ Observer h
--     Nothing -> undefined

newtype ComponentAddHooks = ComponentAddHooks [HookContext -> System ()] deriving anyclass (Typeable ComponentAddHooks
[HookRel ComponentAddHooks]
[Hook ComponentAddHooks]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ComponentAddHooks)
(Typeable ComponentAddHooks,
 IsExclusive (IsExclusiveRel ComponentAddHooks)) =>
Set DefaultComponentType
-> [Hook ComponentAddHooks]
-> [Hook ComponentAddHooks]
-> [Hook ComponentAddHooks]
-> [HookRel ComponentAddHooks]
-> [HookRel ComponentAddHooks]
-> [HookRel ComponentAddHooks]
-> Component ComponentAddHooks
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 ComponentAddHooks]
onAdd :: [Hook ComponentAddHooks]
$conSet :: [Hook ComponentAddHooks]
onSet :: [Hook ComponentAddHooks]
$conRemove :: [Hook ComponentAddHooks]
onRemove :: [Hook ComponentAddHooks]
$conAddRel :: [HookRel ComponentAddHooks]
onAddRel :: [HookRel ComponentAddHooks]
$conSetRel :: [HookRel ComponentAddHooks]
onSetRel :: [HookRel ComponentAddHooks]
$conRemoveRel :: [HookRel ComponentAddHooks]
onRemoveRel :: [HookRel ComponentAddHooks]
Component)

newtype ComponentSetHooks = ComponentSetHooks [HookContext -> System ()] deriving anyclass (Typeable ComponentSetHooks
[HookRel ComponentSetHooks]
[Hook ComponentSetHooks]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ComponentSetHooks)
(Typeable ComponentSetHooks,
 IsExclusive (IsExclusiveRel ComponentSetHooks)) =>
Set DefaultComponentType
-> [Hook ComponentSetHooks]
-> [Hook ComponentSetHooks]
-> [Hook ComponentSetHooks]
-> [HookRel ComponentSetHooks]
-> [HookRel ComponentSetHooks]
-> [HookRel ComponentSetHooks]
-> Component ComponentSetHooks
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 ComponentSetHooks]
onAdd :: [Hook ComponentSetHooks]
$conSet :: [Hook ComponentSetHooks]
onSet :: [Hook ComponentSetHooks]
$conRemove :: [Hook ComponentSetHooks]
onRemove :: [Hook ComponentSetHooks]
$conAddRel :: [HookRel ComponentSetHooks]
onAddRel :: [HookRel ComponentSetHooks]
$conSetRel :: [HookRel ComponentSetHooks]
onSetRel :: [HookRel ComponentSetHooks]
$conRemoveRel :: [HookRel ComponentSetHooks]
onRemoveRel :: [HookRel ComponentSetHooks]
Component)

newtype ComponentRemoveHooks = ComponentRemoveHooks [HookContext -> System ()] deriving anyclass (Typeable ComponentRemoveHooks
[HookRel ComponentRemoveHooks]
[Hook ComponentRemoveHooks]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ComponentRemoveHooks)
(Typeable ComponentRemoveHooks,
 IsExclusive (IsExclusiveRel ComponentRemoveHooks)) =>
Set DefaultComponentType
-> [Hook ComponentRemoveHooks]
-> [Hook ComponentRemoveHooks]
-> [Hook ComponentRemoveHooks]
-> [HookRel ComponentRemoveHooks]
-> [HookRel ComponentRemoveHooks]
-> [HookRel ComponentRemoveHooks]
-> Component ComponentRemoveHooks
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 ComponentRemoveHooks]
onAdd :: [Hook ComponentRemoveHooks]
$conSet :: [Hook ComponentRemoveHooks]
onSet :: [Hook ComponentRemoveHooks]
$conRemove :: [Hook ComponentRemoveHooks]
onRemove :: [Hook ComponentRemoveHooks]
$conAddRel :: [HookRel ComponentRemoveHooks]
onAddRel :: [HookRel ComponentRemoveHooks]
$conSetRel :: [HookRel ComponentRemoveHooks]
onSetRel :: [HookRel ComponentRemoveHooks]
$conRemoveRel :: [HookRel ComponentRemoveHooks]
onRemoveRel :: [HookRel ComponentRemoveHooks]
Component)

newtype ComponentAddHooksRel = ComponentAddHooksRel [HookContextRel -> System ()] deriving anyclass (Typeable ComponentAddHooksRel
[HookRel ComponentAddHooksRel]
[Hook ComponentAddHooksRel]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ComponentAddHooksRel)
(Typeable ComponentAddHooksRel,
 IsExclusive (IsExclusiveRel ComponentAddHooksRel)) =>
Set DefaultComponentType
-> [Hook ComponentAddHooksRel]
-> [Hook ComponentAddHooksRel]
-> [Hook ComponentAddHooksRel]
-> [HookRel ComponentAddHooksRel]
-> [HookRel ComponentAddHooksRel]
-> [HookRel ComponentAddHooksRel]
-> Component ComponentAddHooksRel
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 ComponentAddHooksRel]
onAdd :: [Hook ComponentAddHooksRel]
$conSet :: [Hook ComponentAddHooksRel]
onSet :: [Hook ComponentAddHooksRel]
$conRemove :: [Hook ComponentAddHooksRel]
onRemove :: [Hook ComponentAddHooksRel]
$conAddRel :: [HookRel ComponentAddHooksRel]
onAddRel :: [HookRel ComponentAddHooksRel]
$conSetRel :: [HookRel ComponentAddHooksRel]
onSetRel :: [HookRel ComponentAddHooksRel]
$conRemoveRel :: [HookRel ComponentAddHooksRel]
onRemoveRel :: [HookRel ComponentAddHooksRel]
Component)

newtype ComponentSetHooksRel = ComponentSetHooksRel [HookContextRel -> System ()] deriving anyclass (Typeable ComponentSetHooksRel
[HookRel ComponentSetHooksRel]
[Hook ComponentSetHooksRel]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ComponentSetHooksRel)
(Typeable ComponentSetHooksRel,
 IsExclusive (IsExclusiveRel ComponentSetHooksRel)) =>
Set DefaultComponentType
-> [Hook ComponentSetHooksRel]
-> [Hook ComponentSetHooksRel]
-> [Hook ComponentSetHooksRel]
-> [HookRel ComponentSetHooksRel]
-> [HookRel ComponentSetHooksRel]
-> [HookRel ComponentSetHooksRel]
-> Component ComponentSetHooksRel
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 ComponentSetHooksRel]
onAdd :: [Hook ComponentSetHooksRel]
$conSet :: [Hook ComponentSetHooksRel]
onSet :: [Hook ComponentSetHooksRel]
$conRemove :: [Hook ComponentSetHooksRel]
onRemove :: [Hook ComponentSetHooksRel]
$conAddRel :: [HookRel ComponentSetHooksRel]
onAddRel :: [HookRel ComponentSetHooksRel]
$conSetRel :: [HookRel ComponentSetHooksRel]
onSetRel :: [HookRel ComponentSetHooksRel]
$conRemoveRel :: [HookRel ComponentSetHooksRel]
onRemoveRel :: [HookRel ComponentSetHooksRel]
Component)

newtype ComponentRemoveHooksRel = ComponentRemoveHooksRel [HookContextRel -> System ()] deriving anyclass (Typeable ComponentRemoveHooksRel
[HookRel ComponentRemoveHooksRel]
[Hook ComponentRemoveHooksRel]
Set DefaultComponentType
IsExclusive (IsExclusiveRel ComponentRemoveHooksRel)
(Typeable ComponentRemoveHooksRel,
 IsExclusive (IsExclusiveRel ComponentRemoveHooksRel)) =>
Set DefaultComponentType
-> [Hook ComponentRemoveHooksRel]
-> [Hook ComponentRemoveHooksRel]
-> [Hook ComponentRemoveHooksRel]
-> [HookRel ComponentRemoveHooksRel]
-> [HookRel ComponentRemoveHooksRel]
-> [HookRel ComponentRemoveHooksRel]
-> Component ComponentRemoveHooksRel
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 ComponentRemoveHooksRel]
onAdd :: [Hook ComponentRemoveHooksRel]
$conSet :: [Hook ComponentRemoveHooksRel]
onSet :: [Hook ComponentRemoveHooksRel]
$conRemove :: [Hook ComponentRemoveHooksRel]
onRemove :: [Hook ComponentRemoveHooksRel]
$conAddRel :: [HookRel ComponentRemoveHooksRel]
onAddRel :: [HookRel ComponentRemoveHooksRel]
$conSetRel :: [HookRel ComponentRemoveHooksRel]
onSetRel :: [HookRel ComponentRemoveHooksRel]
$conRemoveRel :: [HookRel ComponentRemoveHooksRel]
onRemoveRel :: [HookRel ComponentRemoveHooksRel]
Component)