module Mischief.ECS.Events where

import Control.Monad.IO.Class
import Data.Foldable (for_)
import Data.IORef (modifyIORef', readIORef, writeIORef)
import Data.List
import Mischief.ECS.Entities
import Mischief.ECS.EventDef
import Mischief.ECS.Observer
import Mischief.ECS.World
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers

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' <- Query System (Observer e, EventProxy e, ObserverOrder)
-> System [(Observer e, EventProxy e, ObserverOrder)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [out]
query (Query System (Observer e, EventProxy e, ObserverOrder)
 -> System [(Observer e, EventProxy e, ObserverOrder)])
-> Query System (Observer e, EventProxy e, ObserverOrder)
-> System [(Observer e, EventProxy e, ObserverOrder)]
forall a b. (a -> b) -> a -> b
$ (C (Observer e), C (EventProxy e), C ObserverOrder)
-> Query System (Observer e, EventProxy e, ObserverOrder)
forall qd out (m :: * -> *). Queryable qd out => qd -> Query m out
mkQuery (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 = ((Observer e, EventProxy e, ObserverOrder)
 -> (Observer e, EventProxy e, ObserverOrder) -> Ordering)
-> [(Observer e, EventProxy e, ObserverOrder)]
-> [(Observer e, EventProxy e, ObserverOrder)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Observer e
_, EventProxy e
_, ObserverOrder
a) (Observer e
_, EventProxy e
_, ObserverOrder
b) -> ObserverOrder -> ObserverOrder -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ObserverOrder
a ObserverOrder
b) [(Observer e, EventProxy e, ObserverOrder)]
observers'
  for_ observers $ \(Observer e
observer, EventProxy e
_, ObserverOrder
_) -> do
    let Observer e -> System ()
f = Observer e
observer
    e -> System ()
f e
event

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

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

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

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