module Mischief.ECS.Events where

import Control.Monad.IO.Class
import Control.Monad.Reader (MonadReader (..))
import Data.Data (Typeable)
import Data.Default (Default)
import Data.Foldable (for_)
import Data.IORef (modifyIORef', readIORef, writeIORef)
import Data.List
import GHC.Generics (Generic)
import GHC.Records
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Required (require)
import Mischief.ECS.Entities
import Mischief.ECS.EventDef
import Mischief.ECS.Observer
import Mischief.ECS.Tables
import Mischief.ECS.World
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Queryable

trigger :: (Event e) => e -> System ()
trigger :: forall e. Event e => e -> System ()
trigger e
event = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  liftIO $ modifyIORef' world.events (++ [eraseEvent event])

flushEvents :: System ()
flushEvents :: System ()
flushEvents = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  events <- liftIO $ readIORef world.events
  for_ events runEvent
  liftIO $ writeIORef world.events []

runEvent :: ErasedEvent -> System ()
runEvent :: ErasedEvent -> System ()
runEvent (ErasedEvent (e
event :: e)) = do
  observers' <- (C (Observer e), C (EventProxy e), C ObserverOrder)
-> System
     [(Result (Observer e), Result (EventProxy e),
       Result ObserverOrder)]
forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> m [output]
query (forall a. C a
forall {k} (a :: k). C a
C @(Observer e), forall a. C a
forall {k} (a :: k). C a
C @(EventProxy e), forall a. C a
forall {k} (a :: k). C a
C @ObserverOrder)
  let observers = ((Result (Observer e), Result (EventProxy e), Result ObserverOrder)
 -> (Result (Observer e), Result (EventProxy e),
     Result ObserverOrder)
 -> Ordering)
-> [(Result (Observer e), Result (EventProxy e),
     Result ObserverOrder)]
-> [(Result (Observer e), Result (EventProxy e),
     Result ObserverOrder)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Result (Observer e)
_, Result (EventProxy e)
_, Result ObserverOrder
a) (Result (Observer e)
_, Result (EventProxy e)
_, Result ObserverOrder
b) -> Result ObserverOrder -> Result ObserverOrder -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Result ObserverOrder
a Result ObserverOrder
b) [(Result (Observer e), Result (EventProxy e),
  Result ObserverOrder)]
observers'
  for_ observers $ \(Result (Observer e)
observer, Result (EventProxy e)
_, Result ObserverOrder
_) -> do
    let Observer e -> System ()
f = Result (Observer e) -> Observer e
forall c. Result c -> c
value Result (Observer e)
observer
    e -> System ()
f e
event

newtype OnInsert c = OnInsert {forall {k} (c :: k). OnInsert c -> Entity
entity :: Entity}
  deriving anyclass (Typeable (OnInsert c)
Typeable (OnInsert c) =>
(OnInsert c -> ErasedEvent) -> Event (OnInsert c)
OnInsert c -> ErasedEvent
forall e. Typeable e => (e -> ErasedEvent) -> Event e
forall k (c :: k).
(Typeable c, Typeable k) =>
Typeable (OnInsert c)
forall k (c :: k).
(Typeable c, Typeable k) =>
OnInsert c -> ErasedEvent
$ceraseEvent :: forall k (c :: k).
(Typeable c, Typeable k) =>
OnInsert c -> ErasedEvent
eraseEvent :: OnInsert c -> ErasedEvent
Event)
  deriving stock (Int -> OnInsert c -> ShowS
[OnInsert c] -> ShowS
OnInsert c -> String
(Int -> OnInsert c -> ShowS)
-> (OnInsert c -> String)
-> ([OnInsert c] -> ShowS)
-> Show (OnInsert c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (c :: k). Int -> OnInsert c -> ShowS
forall k (c :: k). [OnInsert c] -> ShowS
forall k (c :: k). OnInsert c -> String
$cshowsPrec :: forall k (c :: k). Int -> OnInsert c -> ShowS
showsPrec :: Int -> OnInsert c -> ShowS
$cshow :: forall k (c :: k). OnInsert c -> String
show :: OnInsert c -> String
$cshowList :: forall k (c :: k). [OnInsert c] -> ShowS
showList :: [OnInsert c] -> ShowS
Show)

data OnInsertRel c = OnInsertRel {forall {k} (c :: k). OnInsertRel c -> Entity
entity :: Entity, forall {k} (c :: k). OnInsertRel c -> Entity
target :: Entity}
  deriving anyclass (Typeable (OnInsertRel c)
Typeable (OnInsertRel c) =>
(OnInsertRel c -> ErasedEvent) -> Event (OnInsertRel c)
OnInsertRel c -> ErasedEvent
forall e. Typeable e => (e -> ErasedEvent) -> Event e
forall k (c :: k).
(Typeable c, Typeable k) =>
Typeable (OnInsertRel c)
forall k (c :: k).
(Typeable c, Typeable k) =>
OnInsertRel c -> ErasedEvent
$ceraseEvent :: forall k (c :: k).
(Typeable c, Typeable k) =>
OnInsertRel c -> ErasedEvent
eraseEvent :: OnInsertRel c -> ErasedEvent
Event)
  deriving stock (Int -> OnInsertRel c -> ShowS
[OnInsertRel c] -> ShowS
OnInsertRel c -> String
(Int -> OnInsertRel c -> ShowS)
-> (OnInsertRel c -> String)
-> ([OnInsertRel c] -> ShowS)
-> Show (OnInsertRel c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (c :: k). Int -> OnInsertRel c -> ShowS
forall k (c :: k). [OnInsertRel c] -> ShowS
forall k (c :: k). OnInsertRel c -> String
$cshowsPrec :: forall k (c :: k). Int -> OnInsertRel c -> ShowS
showsPrec :: Int -> OnInsertRel c -> ShowS
$cshow :: forall k (c :: k). OnInsertRel c -> String
show :: OnInsertRel c -> String
$cshowList :: forall k (c :: k). [OnInsertRel c] -> ShowS
showList :: [OnInsertRel c] -> ShowS
Show)

newtype OnRemove c = OnRemove {forall {k} (c :: k). OnRemove c -> Entity
entity :: Entity}
  deriving anyclass (Typeable (OnRemove c)
Typeable (OnRemove c) =>
(OnRemove c -> ErasedEvent) -> Event (OnRemove c)
OnRemove c -> ErasedEvent
forall e. Typeable e => (e -> ErasedEvent) -> Event e
forall k (c :: k).
(Typeable c, Typeable k) =>
Typeable (OnRemove c)
forall k (c :: k).
(Typeable c, Typeable k) =>
OnRemove c -> ErasedEvent
$ceraseEvent :: forall k (c :: k).
(Typeable c, Typeable k) =>
OnRemove c -> ErasedEvent
eraseEvent :: OnRemove c -> ErasedEvent
Event)
  deriving stock (Int -> OnRemove c -> ShowS
[OnRemove c] -> ShowS
OnRemove c -> String
(Int -> OnRemove c -> ShowS)
-> (OnRemove c -> String)
-> ([OnRemove c] -> ShowS)
-> Show (OnRemove c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (c :: k). Int -> OnRemove c -> ShowS
forall k (c :: k). [OnRemove c] -> ShowS
forall k (c :: k). OnRemove c -> String
$cshowsPrec :: forall k (c :: k). Int -> OnRemove c -> ShowS
showsPrec :: Int -> OnRemove c -> ShowS
$cshow :: forall k (c :: k). OnRemove c -> String
show :: OnRemove c -> String
$cshowList :: forall k (c :: k). [OnRemove c] -> ShowS
showList :: [OnRemove c] -> ShowS
Show)

data OnRemoveRel c = OnRemoveRel {forall {k} (c :: k). OnRemoveRel c -> Entity
entity :: Entity, forall {k} (c :: k). OnRemoveRel c -> Entity
target :: Entity}
  deriving anyclass (Typeable (OnRemoveRel c)
Typeable (OnRemoveRel c) =>
(OnRemoveRel c -> ErasedEvent) -> Event (OnRemoveRel c)
OnRemoveRel c -> ErasedEvent
forall e. Typeable e => (e -> ErasedEvent) -> Event e
forall k (c :: k).
(Typeable c, Typeable k) =>
Typeable (OnRemoveRel c)
forall k (c :: k).
(Typeable c, Typeable k) =>
OnRemoveRel c -> ErasedEvent
$ceraseEvent :: forall k (c :: k).
(Typeable c, Typeable k) =>
OnRemoveRel c -> ErasedEvent
eraseEvent :: OnRemoveRel c -> ErasedEvent
Event)
  deriving stock (Int -> OnRemoveRel c -> ShowS
[OnRemoveRel c] -> ShowS
OnRemoveRel c -> String
(Int -> OnRemoveRel c -> ShowS)
-> (OnRemoveRel c -> String)
-> ([OnRemoveRel c] -> ShowS)
-> Show (OnRemoveRel c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (c :: k). Int -> OnRemoveRel c -> ShowS
forall k (c :: k). [OnRemoveRel c] -> ShowS
forall k (c :: k). OnRemoveRel c -> String
$cshowsPrec :: forall k (c :: k). Int -> OnRemoveRel c -> ShowS
showsPrec :: Int -> OnRemoveRel c -> ShowS
$cshow :: forall k (c :: k). OnRemoveRel c -> String
show :: OnRemoveRel c -> String
$cshowList :: forall k (c :: k). [OnRemoveRel c] -> ShowS
showList :: [OnRemoveRel c] -> ShowS
Show)