{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.Components.Spawn where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
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 Data.IORef
import Data.Kind
import Data.Map qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import GHC.Base (Word (..))
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Common
import Mischief.ECS.Components.HooksDef
import Mischief.ECS.Components.Required (requireAll)
import Mischief.ECS.Entities
import Mischief.ECS.EntityDef
import Mischief.ECS.Log
import Mischief.ECS.Observer
import Mischief.ECS.Relationships
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 @(RelExclusivity 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 $ hooks @c

      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 :: Hooks c -> System ()
registerHooks :: forall {k} (c :: k). Hooks c -> System ()
registerHooks (Hooks [ErasedHook c]
h) = [ErasedHook c] -> (ErasedHook c -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ErasedHook c]
h ErasedHook c -> System ()
forall {k} (c :: k). ErasedHook c -> System ()
registerHook

registerHook :: ErasedHook c -> System ()
registerHook :: forall {k} (c :: k). ErasedHook c -> System ()
registerHook (ErasedHook (e c -> m ()
h :: e c -> m ())) = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  e <- liftIO $ getNewEntity world.entities
  case eqT @m @System of
    Just m :~: System
Refl -> System () -> System ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ Entity -> Observer (e c) -> System ()
forall b. Bundle b => Entity -> b -> System ()
worldSpawnByInsert Entity
e (Observer (e c) -> System ()) -> Observer (e c) -> System ()
forall a b. (a -> b) -> a -> b
$ (e c -> System ()) -> Observer (e c)
forall e. (e -> System ()) -> Observer e
Observer e c -> m ()
e c -> System ()
h
    Maybe (m :~: System)
Nothing -> System ()
forall a. HasCallStack => a
undefined