{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.World.Remove (remove, removeRel, triggerRemoveEvent) where

import Control.Monad
import Control.Monad.Reader
import Data.Data
import Data.Foldable
import Data.IORef
import Data.Text qualified as T
import GHC.Base (Int (..), eqWord#, isTrue#)
import Mischief.ECS.Archetypes.Graph
import Mischief.ECS.Collectable
import Mischief.ECS.Components
import Mischief.ECS.Components.HooksDef (HookContext (..), HookContextRel (..))
import Mischief.ECS.Components.Spawn
import Mischief.ECS.Entities
import Mischief.ECS.Events
import Mischief.ECS.Log
import Mischief.ECS.World
import Mischief.ECS.World.Change (changeArchetype)
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers
import Mischief.ECS.World.Query.Queryable

newtype ToRemove = ToRemove {ToRemove -> [(ComponentType, Maybe Entity, Maybe Any)]
inner :: [(ComponentType, Maybe Entity, Maybe Any)]} deriving newtype (NonEmpty ToRemove -> ToRemove
ToRemove -> ToRemove -> ToRemove
(ToRemove -> ToRemove -> ToRemove)
-> (NonEmpty ToRemove -> ToRemove)
-> (forall b. Integral b => b -> ToRemove -> ToRemove)
-> Semigroup ToRemove
forall b. Integral b => b -> ToRemove -> ToRemove
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ToRemove -> ToRemove -> ToRemove
<> :: ToRemove -> ToRemove -> ToRemove
$csconcat :: NonEmpty ToRemove -> ToRemove
sconcat :: NonEmpty ToRemove -> ToRemove
$cstimes :: forall b. Integral b => b -> ToRemove -> ToRemove
stimes :: forall b. Integral b => b -> ToRemove -> ToRemove
Semigroup)

instance (Component c) => EraseIntoStorage (C c) ToRemove where
  erase :: C c -> ToRemove
erase C c
_ = [(ComponentType, Maybe Entity, Maybe Any)] -> ToRemove
ToRemove [(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, Maybe Entity
forall a. Maybe a
Nothing, Maybe Any
forall a. Maybe a
Nothing)]

instance (Component c) => EraseIntoStorage (R c Entity) ToRemove where
  erase :: R c Entity -> ToRemove
erase (R !Entity
e) = [(ComponentType, Maybe Entity, Maybe Any)] -> ToRemove
ToRemove [(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 -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e, Maybe Any
forall a. Maybe a
Nothing)]

instance (Component c) => EraseIntoStorage (R c Any) ToRemove where
  erase :: R c Any -> ToRemove
erase R c Any
_ = [(ComponentType, Maybe Entity, Maybe Any)] -> ToRemove
ToRemove [(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, Maybe Entity
forall a. Maybe a
Nothing, Any -> Maybe Any
forall a. a -> Maybe a
Just Any
Any)]

remove :: (Collectable c ToRemove) => c -> Entity -> System ()
remove :: forall c. Collectable c ToRemove => c -> Entity -> System ()
remove !c
c !Entity
entity = do
  let !ToRemove
list :: ToRemove = c -> ToRemove
forall v storage. Collectable v storage => v -> storage
collect c
c
  [(ComponentType, Maybe Entity, Maybe Any)]
-> ((ComponentType, Maybe Entity, Maybe Any) -> System ())
-> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ToRemove
list.inner (((ComponentType, Maybe Entity, Maybe Any) -> System ())
 -> System ())
-> ((ComponentType, Maybe Entity, Maybe Any) -> System ())
-> System ()
forall a b. (a -> b) -> a -> b
$ \case
    (!ComponentType
x, Maybe Entity
Nothing, Maybe Any
Nothing) -> do
      !comp <- ComponentType -> System ComponentId
getOrAddComponentId ComponentType
x
      removeFromEntity [comp] entity
    (!ComponentType
x, Just !Entity
target, Maybe Any
_) -> do
      !comp <- Pair -> System ComponentId
getOrAddPairId ((ComponentType, Entity) -> Pair
Pair (ComponentType
x, Entity
target))
      removeFromEntity [comp] entity
    (!ComponentType
x, Maybe Entity
_, Just Any
_) -> do
      ComponentType -> Entity -> System ()
removeRelationshipsFromEntity ComponentType
x Entity
entity

removeRel :: forall c. (Component c) => Entity -> Entity -> System ()
removeRel :: forall c. Component c => Entity -> Entity -> System ()
removeRel = forall c. Component c => Entity -> Entity -> System ()
removeRelationshipFromEntity @c

removeRelationshipFromEntity :: forall c. (Component c) => Entity -> Entity -> System ()
removeRelationshipFromEntity :: forall c. Component c => Entity -> Entity -> System ()
removeRelationshipFromEntity !Entity
target !Entity
entity = do
  !componentId <- Pair -> System ComponentId
getOrAddPairId ((ComponentType, Entity) -> Pair
Pair (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
target))
  removeFromEntity [componentId] entity

removeRelationshipsFromEntity :: ComponentType -> Entity -> System ()
removeRelationshipsFromEntity :: ComponentType -> Entity -> System ()
removeRelationshipsFromEntity !ComponentType
x !Entity
entity = do
  !world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  !ids <- liftIO $ findComponentsOfEntity world entity
  (ComponentId (# !id, _ #)) <- getOrAddComponentId x
  for_ ids $ \(![ComponentId]
ids') -> do
    let !ids :: [ComponentId]
ids = (ComponentId -> Bool) -> [ComponentId] -> [ComponentId]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ComponentId (# !Word#
id', Maybe Entity
_ #)) -> Int# -> Bool
isTrue# (Int# -> Bool) -> Int# -> Bool
forall a b. (a -> b) -> a -> b
$ Word# -> Word# -> Int#
eqWord# Word#
id Word#
id') [ComponentId]
ids'
    [ComponentId] -> Entity -> System ()
removeFromEntity [ComponentId]
ids Entity
entity

removeFromEntity :: [ComponentId] -> Entity -> System ()
removeFromEntity :: [ComponentId] -> Entity -> System ()
removeFromEntity ![ComponentId]
components !Entity
entity = do
  !world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  !pointer <- liftIO $ getPointer entity world.entities

  case pointer of
    Maybe (IORef EntityPointer)
Nothing -> Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn (Text -> System ()) -> Text -> System ()
forall a b. (a -> b) -> a -> b
$ Text
"Removal failed: Entity " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity -> Text
forall a. Show a => a -> Text
T.show Entity
entity Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not alive."
    Just !IORef EntityPointer
pointer -> do
      (EntityPointer (# !archetypeId, _ #)) <- IO EntityPointer -> System EntityPointer
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntityPointer -> System EntityPointer)
-> IO EntityPointer -> System EntityPointer
forall a b. (a -> b) -> a -> b
$ IORef EntityPointer -> IO EntityPointer
forall a. IORef a -> IO a
readIORef IORef EntityPointer
pointer

      (!newArchetype, !removedComponents) <- getArchetypeOnRemove (ArchetypeId $ I# archetypeId) components
      triggerRemoveEvent removedComponents entity

      void $ changeArchetype entity newArchetype Nothing

triggerRemoveEvent :: [ComponentId] -> Entity -> System ()
triggerRemoveEvent :: [ComponentId] -> Entity -> System ()
triggerRemoveEvent ![ComponentId]
components !Entity
entity = do
  [ComponentId] -> (ComponentId -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ComponentId]
components ((ComponentId -> System ()) -> System ())
-> (ComponentId -> System ()) -> System ()
forall a b. (a -> b) -> a -> b
$ \(ComponentId (# !Word#
id, !Maybe Entity
target #)) -> do
    Just !t <- Query System ComponentType -> System (Maybe ComponentType)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single (Query System ComponentType -> System (Maybe ComponentType))
-> Query System ComponentType -> System (Maybe ComponentType)
forall a b. (a -> b) -> a -> b
$ Entity -> C ComponentType -> Query System ComponentType
forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> Query m out
mkGet ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #)) (forall a. C a
forall {k} (a :: k). C a
C @ComponentType)
    case target of
      Maybe Entity
Nothing -> ComponentType -> Entity -> System ()
triggerRemoveEventC ComponentType
t Entity
entity
      Just !Entity
target -> ComponentType -> Entity -> Entity -> System ()
triggerRemoveEventR ComponentType
t Entity
target Entity
entity

triggerRemoveEventC :: ComponentType -> Entity -> System ()
triggerRemoveEventC :: ComponentType -> Entity -> System ()
triggerRemoveEventC (ComponentType (Proxy c
_ :: Proxy t)) !Entity
entity = do
  OnRemove c -> System ()
forall e. Event e => e -> System ()
trigger (OnRemove c -> System ()) -> OnRemove c -> System ()
forall a b. (a -> b) -> a -> b
$ forall c. Entity -> OnRemove c
forall {k} (c :: k). Entity -> OnRemove c
OnRemove @t Entity
entity

  let !context :: HookContext
context = HookContext {Entity
entity :: Entity
entity :: Entity
entity}
  !m <- forall c. Component c => System Entity
meta @t
  Just !hooks <- single $ mkGet m (M @ComponentRemoveHooks)
  for_ hooks $ \(ComponentRemoveHooks ![HookContext -> System ()]
h) -> do
    [HookContext -> System ()]
-> ((HookContext -> System ()) -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [HookContext -> System ()]
h (((HookContext -> System ()) -> System ()) -> System ())
-> ((HookContext -> System ()) -> System ()) -> System ()
forall a b. (a -> b) -> a -> b
$ \(!HookContext -> System ()
h) -> HookContext -> System ()
h HookContext
context

triggerRemoveEventR :: ComponentType -> Entity -> Entity -> System ()
triggerRemoveEventR :: ComponentType -> Entity -> Entity -> System ()
triggerRemoveEventR (ComponentType (Proxy c
_ :: Proxy t)) !Entity
target !Entity
entity = do
  OnRemoveRel c -> System ()
forall e. Event e => e -> System ()
trigger (OnRemoveRel c -> System ()) -> OnRemoveRel c -> System ()
forall a b. (a -> b) -> a -> b
$ forall c. Entity -> Entity -> OnRemoveRel c
forall {k} (c :: k). Entity -> Entity -> OnRemoveRel c
OnRemoveRel @t Entity
entity Entity
target

  let !context :: HookContextRel
context = HookContextRel {Entity
entity :: Entity
entity :: Entity
entity, Entity
target :: Entity
target :: Entity
target}

  !m <- forall c. Component c => System Entity
meta @t
  Just !hooks <- single $ mkGet m (M @ComponentRemoveHooksRel)
  for_ hooks $ \(ComponentRemoveHooksRel ![HookContextRel -> System ()]
h) -> do
    [HookContextRel -> System ()]
-> ((HookContextRel -> System ()) -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [HookContextRel -> System ()]
h (((HookContextRel -> System ()) -> System ()) -> System ())
-> ((HookContextRel -> System ()) -> System ()) -> System ()
forall a b. (a -> b) -> a -> b
$ \(!HookContextRel -> System ()
h) -> HookContextRel -> System ()
h HookContextRel
context