{-# LANGUAGE AllowAmbiguousTypes #-}

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

import Control.Monad
import Control.Monad.Reader
import Data.Data
import Data.Foldable
import Data.IORef
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Base (Int (..), eqWord#, isTrue#)
import Mischief.ECS.Archetypes
import Mischief.ECS.Archetypes.Graph
import Mischief.ECS.Collectable
import Mischief.ECS.Components
import Mischief.ECS.Components.Common
import Mischief.ECS.Components.Spawn
import Mischief.ECS.Entities
import Mischief.ECS.EntityDef
import Mischief.ECS.EventDef
import Mischief.ECS.Events
import Mischief.ECS.Log
import Mischief.ECS.Tables
import Mischief.ECS.World
import Mischief.ECS.World.Change (changeArchetype)
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Queryable
import Mischief.ECS.World.Utils

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 :: forall r. (Removable r) => Entity -> System ()
-- remove entity = do
--   types <- getTypes (Proxy @r)
--   removeFromEntity (Set.toList types) entity

class Delete r where
  delete :: r -> System ()

class Delete' r isRel where
  delete' :: r -> System ()

instance (Delete' (Result r) (IsComp r)) => Delete (Result r) where
  delete :: Result r -> System ()
delete = forall r (isRel :: Bool). Delete' r isRel => r -> System ()
forall {k} r (isRel :: k). Delete' r isRel => r -> System ()
delete' @(Result r) @(IsComp r)

instance (Component c) => Delete' (Result c) True where
  delete' :: Result c -> System ()
  delete' :: Result c -> System ()
delete' Result c
result = C c -> Entity -> System ()
forall c. Collectable c ToRemove => c -> Entity -> System ()
remove (forall a. C a
forall {k} (a :: k). C a
C @c) (Result c -> Entity
forall c. Result c -> Entity
entityOf Result c
result)

instance (Component c) => Delete' (Result (Rel c)) False where
  delete' :: Result (Rel c) -> System ()
  delete' :: Result (Rel c) -> System ()
delete' Result (Rel c)
result = R c Entity -> Entity -> System ()
forall c. Collectable c ToRemove => c -> Entity -> System ()
remove (forall {k} (a :: k) b. b -> R a b
forall a b. b -> R a b
R @c Result (Rel c)
result.target) (Result (Rel c) -> Entity
forall c. Result c -> Entity
entityOf Result (Rel c)
result)

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
text 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 <- C ComponentType -> Entity -> System (Maybe (Result ComponentType))
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (forall a. C a
forall {k} (a :: k). C a
C @ComponentType) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
    case target of
      Maybe Entity
Nothing -> ComponentType -> Entity -> System ()
triggerRemoveEventC (Result ComponentType -> ComponentType
forall c. Result c -> c
value Result ComponentType
t) Entity
entity
      Just Entity
target -> ComponentType -> Entity -> Entity -> System ()
triggerRemoveEventR (Result ComponentType -> ComponentType
forall c. Result c -> c
value Result ComponentType
t) Entity
target Entity
entity

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

triggerRemoveEventR :: ComponentType -> Entity -> Entity -> System ()
triggerRemoveEventR :: ComponentType -> Entity -> Entity -> System ()
triggerRemoveEventR (ComponentType (Proxy c
_ :: Proxy t)) Entity
target Entity
entity =
  ErasedEvent -> System ()
runEvent (ErasedEvent -> System ()) -> ErasedEvent -> System ()
forall a b. (a -> b) -> a -> b
$ OnRemoveRel c -> ErasedEvent
forall e. Event e => e -> ErasedEvent
eraseEvent (OnRemoveRel c -> ErasedEvent) -> OnRemoveRel c -> ErasedEvent
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