{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- {-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Mischief.ECS.Hooks
  ( relComplementary,
    relCleanup,
    relCleanupRemove,
    relCleanupDespawn,
  )
where

import Control.Monad
import Data.Data
import Data.Foldable
import Data.Kind
import Data.Maybe
import Mischief.ECS.Collectable
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Common
import Mischief.ECS.Components.Hooks
import Mischief.ECS.Components.HooksDef
import Mischief.ECS.Entities
import Mischief.ECS.EventDef
import Mischief.ECS.Events
import Mischief.ECS.Log
import Mischief.ECS.Tables
import Mischief.ECS.Utils
import Mischief.ECS.World
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Queryable
import Mischief.ECS.World.Remove
import Mischief.ECS.World.Spawn
import Mischief.ECS.World.Utils

instance (Event (e c)) => EraseIntoStorage (e c -> System ()) (Hooks c) where
  erase :: (e c -> System ()) -> Hooks c
  erase :: (e c -> System ()) -> Hooks c
erase e c -> System ()
x = [ErasedHook c] -> Hooks c
forall {k} (c :: k). [ErasedHook c] -> Hooks c
Hooks [(e c -> System ()) -> ErasedHook c
forall {k} (e :: k -> *) (c :: k) (m :: * -> *).
(Event (e c), Typeable m) =>
(e c -> m ()) -> ErasedHook c
ErasedHook e c -> System ()
x]

instance EraseIntoStorage (Hooks c) (Hooks c) where
  erase :: Hooks c -> Hooks c
erase = Hooks c -> Hooks c
forall a. a -> a
id

-- | When applied on a component @A@, this hook takes a function @(A -> B)@ and does two things:
--
-- 1. When @'Rel' (A, y)@ is inserted on entity @x@, @'Rel' (B, x)@ will be inserted on @y@ (the value of @B@ obtained through the provided function).
--
-- 2. When @'Rel' (a, y)@ is removed from an entity @x@, @'Rel' (B, x)@ will be removed from @y@.
relComplementary :: forall (a :: Type) b. (Component a, Component b) => (a -> b) -> Hooks a
relComplementary :: forall a b. (Component a, Component b) => (a -> b) -> Hooks a
relComplementary a -> b
f = (OnInsertRel a -> System (), OnRemoveRel a -> System ()) -> Hooks a
forall v storage. Collectable v storage => v -> storage
collect ((a -> b) -> OnInsertRel a -> System ()
forall a b.
(Component b, Component a) =>
(a -> b) -> OnInsertRel a -> System ()
insertComplementary a -> b
f, forall b a. Component b => OnRemoveRel a -> System ()
forall {k} b (a :: k). Component b => OnRemoveRel a -> System ()
removeComplementary @b @a)

insertComplementary :: forall (a :: Type) b. (Component b, Component a) => (a -> b) -> OnInsertRel a -> System ()
insertComplementary :: forall a b.
(Component b, Component a) =>
(a -> b) -> OnInsertRel a -> System ()
insertComplementary a -> b
f OnInsertRel a
event = do
  -- warn $ text event.target
  Just val <- R a Entity -> Entity -> System (Maybe (Result (Rel a)))
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (forall {k} (a :: k) b. b -> R a b
forall a b. b -> R a b
R @a OnInsertRel a
event.target) OnInsertRel a
event.entity
  insert (Rel (f val.comp) event.entity) event.target

removeComplementary :: forall b a. (Component b) => OnRemoveRel a -> System ()
removeComplementary :: forall {k} b (a :: k). Component b => OnRemoveRel a -> System ()
removeComplementary OnRemoveRel a
event = forall c. Component c => Entity -> Entity -> System ()
removeRel @b OnRemoveRel a
event.entity OnRemoveRel a
event.target

relCleanup :: forall (a :: Type). (Component a) => (CleanupRequest -> System ()) -> Hooks a
relCleanup :: forall a. Component a => (CleanupRequest -> System ()) -> Hooks a
relCleanup CleanupRequest -> System ()
f = (OnInsertRel a -> System (), OnRemoveRel a -> System ()) -> Hooks a
forall v storage. Collectable v storage => v -> storage
collect (forall c.
Component c =>
(CleanupRequest -> System ()) -> OnInsertRel c -> System ()
insertCleanupWatcher @a CleanupRequest -> System ()
f, forall c. Component c => OnRemoveRel c -> System ()
removeCleanupWatcher @a)

relCleanupRemove :: forall (a :: Type). (Component a) => Hooks a
relCleanupRemove :: forall a. Component a => Hooks a
relCleanupRemove = (CleanupRequest -> System ()) -> Hooks a
forall a. Component a => (CleanupRequest -> System ()) -> Hooks a
relCleanup (\CleanupRequest
r -> forall c. Component c => Entity -> Entity -> System ()
removeRel @a CleanupRequest
r.target CleanupRequest
r.entity)

relCleanupDespawn :: forall (a :: Type). (Component a) => Hooks a
relCleanupDespawn :: forall a. Component a => Hooks a
relCleanupDespawn = (CleanupRequest -> System ()) -> Hooks a
forall a. Component a => (CleanupRequest -> System ()) -> Hooks a
relCleanup (\CleanupRequest
r -> Entity -> System ()
despawn CleanupRequest
r.entity)

insertCleanupWatcher :: forall c. (Component c) => (CleanupRequest -> System ()) -> OnInsertRel c -> System ()
insertCleanupWatcher :: forall c.
Component c =>
(CleanupRequest -> System ()) -> OnInsertRel c -> System ()
insertCleanupWatcher CleanupRequest -> System ()
f OnInsertRel c
e = forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
Rel (CleanupWatcher c) -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert (CleanupWatcher c -> Entity -> Rel (CleanupWatcher c)
forall c. c -> Entity -> Rel c
Rel (forall c. (CleanupRequest -> System ()) -> CleanupWatcher c
forall {k} (c :: k).
(CleanupRequest -> System ()) -> CleanupWatcher c
CleanupWatcher @c CleanupRequest -> System ()
f) OnInsertRel c
e.entity) OnInsertRel c
e.target

removeCleanupWatcher :: forall c. (Component c) => OnRemoveRel c -> System ()
removeCleanupWatcher :: forall c. Component c => OnRemoveRel c -> System ()
removeCleanupWatcher OnRemoveRel c
e = do
  forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
Rel (CleanupWatcher c) -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert (CleanupWatcher c -> Entity -> Rel (CleanupWatcher c)
forall c. c -> Entity -> Rel c
Rel (forall c. (CleanupRequest -> System ()) -> CleanupWatcher c
forall {k} (c :: k).
(CleanupRequest -> System ()) -> CleanupWatcher c
CleanupWatcher @c (() -> System ()
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> System ())
-> (CleanupRequest -> ()) -> CleanupRequest -> System ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> CleanupRequest -> ()
forall a. a -> CleanupRequest -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) OnRemoveRel c
e.entity) OnRemoveRel c
e.target
  forall c. Component c => Entity -> Entity -> System ()
removeRel @(CleanupWatcher c) OnRemoveRel c
e.entity OnRemoveRel c
e.target

newtype CleanupWatcher c = CleanupWatcher {forall {k} (c :: k).
CleanupWatcher c -> CleanupRequest -> System ()
function :: CleanupRequest -> System ()}

data CleanupRequest = CleanupRequest
  { CleanupRequest -> Entity
entity :: Entity,
    CleanupRequest -> Entity
target :: Entity
  }

instance (Component c) => Component (CleanupWatcher c) where
  hooks :: Hooks (CleanupWatcher c)
hooks = (OnRemoveRel (CleanupWatcher c) -> System ())
-> Hooks (CleanupWatcher c)
forall v storage. Collectable v storage => v -> storage
collect ((OnRemoveRel (CleanupWatcher c) -> System ())
 -> Hooks (CleanupWatcher c))
-> (OnRemoveRel (CleanupWatcher c) -> System ())
-> Hooks (CleanupWatcher c)
forall a b. (a -> b) -> a -> b
$ forall c.
Component c =>
OnRemoveRel (CleanupWatcher c) -> System ()
triggerCleanup @c

triggerCleanup :: forall c. (Component c) => OnRemoveRel (CleanupWatcher c) -> System ()
triggerCleanup :: forall c.
Component c =>
OnRemoveRel (CleanupWatcher c) -> System ()
triggerCleanup OnRemoveRel (CleanupWatcher c)
e = do
  Just watcher <- R (CleanupWatcher c) Entity
-> Entity -> System (Maybe (Result (Rel (CleanupWatcher c))))
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (forall {k} (a :: k) b. b -> R a b
forall a b. b -> R a b
R @(CleanupWatcher c) OnRemoveRel (CleanupWatcher c)
e.target) OnRemoveRel (CleanupWatcher c)
e.entity
  watcher.comp.function CleanupRequest {entity = e.target, target = e.entity}