{-# LANGUAGE AllowAmbiguousTypes #-}

-- |
-- Module with utility functions for creating
-- and scheduling systems.
module Mischief.ECS.Systems where

import Data.Foldable
import Language.Haskell.TH (Extension (AllowAmbiguousTypes))
import Mischief.ECS.App.Schedules
import Mischief.ECS.App.Systems (ScheduledIn, SystemFunction (SystemFunction), removeSystemFromMap, systemEntity)
import Mischief.ECS.Collectable
import Mischief.ECS.Components
import Mischief.ECS.Entities
import Mischief.ECS.Relationships.Order
import Mischief.ECS.World
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers
import Mischief.ECS.World.Query.QueryFilter
import Mischief.ECS.World.Remove
import Mischief.ECS.World.Spawn
import Mischief.ECS.World.Spawn qualified as Spawn

data SystemConfig = SystemConfig
  { SystemConfig -> [System ()]
systems :: [System ()],
    SystemConfig -> [(System (), System ())]
edges :: [(System (), System ())]
  }

newtype Systems = Systems [System ()] deriving newtype (NonEmpty Systems -> Systems
Systems -> Systems -> Systems
(Systems -> Systems -> Systems)
-> (NonEmpty Systems -> Systems)
-> (forall b. Integral b => b -> Systems -> Systems)
-> Semigroup Systems
forall b. Integral b => b -> Systems -> Systems
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Systems -> Systems -> Systems
<> :: Systems -> Systems -> Systems
$csconcat :: NonEmpty Systems -> Systems
sconcat :: NonEmpty Systems -> Systems
$cstimes :: forall b. Integral b => b -> Systems -> Systems
stimes :: forall b. Integral b => b -> Systems -> Systems
Semigroup)

instance EraseIntoStorage (System ()) Systems where
  erase :: System () -> Systems
erase System ()
a = [System ()] -> Systems
Systems [System ()
a]

type ToSystems a = Collectable a Systems

systems :: (ToSystems a) => a -> SystemConfig
systems :: forall a. ToSystems a => a -> SystemConfig
systems a
a =
  let Systems [System ()]
systems = a -> Systems
forall v storage. Collectable v storage => v -> storage
collect a
a
   in SystemConfig {[System ()]
systems :: [System ()]
systems :: [System ()]
systems, edges :: [(System (), System ())]
edges = []}

after :: (ToSystems a) => a -> SystemConfig -> SystemConfig
after :: forall a. ToSystems a => a -> SystemConfig -> SystemConfig
after a
a SystemConfig
s =
  let Systems [System ()]
systems = a -> Systems
forall v storage. Collectable v storage => v -> storage
collect a
a
   in SystemConfig {systems :: [System ()]
systems = SystemConfig
s.systems, edges :: [(System (), System ())]
edges = SystemConfig
s.edges [(System (), System ())]
-> [(System (), System ())] -> [(System (), System ())]
forall a. [a] -> [a] -> [a]
++ [System ()] -> [System ()] -> [(System (), System ())]
forall a b. [a] -> [b] -> [(a, b)]
zip [System ()]
systems SystemConfig
s.systems}

before :: (ToSystems a) => a -> SystemConfig -> SystemConfig
before :: forall a. ToSystems a => a -> SystemConfig -> SystemConfig
before a
a SystemConfig
s =
  let Systems [System ()]
systems = a -> Systems
forall v storage. Collectable v storage => v -> storage
collect a
a
   in SystemConfig {systems :: [System ()]
systems = SystemConfig
s.systems, edges :: [(System (), System ())]
edges = SystemConfig
s.edges [(System (), System ())]
-> [(System (), System ())] -> [(System (), System ())]
forall a. [a] -> [a] -> [a]
++ [System ()] -> [System ()] -> [(System (), System ())]
forall a b. [a] -> [b] -> [(a, b)]
zip SystemConfig
s.systems [System ()]
systems}

schedule :: forall sc. (Schedule sc) => SystemConfig -> System ()
schedule :: forall {k} (sc :: k). Schedule sc => SystemConfig -> System ()
schedule SystemConfig {[System ()]
systems :: SystemConfig -> [System ()]
systems :: [System ()]
systems, [(System (), System ())]
edges :: SystemConfig -> [(System (), System ())]
edges :: [(System (), System ())]
edges} = do
  [System ()] -> (System () -> System Entity) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [System ()]
systems ((System () -> System Entity) -> System ())
-> (System () -> System Entity) -> System ()
forall a b. (a -> b) -> a -> b
$ \System ()
system -> forall (sch :: k).
(HasCallStack, Schedule sch) =>
System () -> System Entity
forall {k} (sch :: k).
(HasCallStack, Schedule sch) =>
System () -> System Entity
systemEntity @sc System ()
system

  [(System (), System ())]
-> ((System (), System ()) -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(System (), System ())]
edges (((System (), System ()) -> System ()) -> System ())
-> ((System (), System ()) -> System ()) -> System ()
forall a b. (a -> b) -> a -> b
$ \(System ()
s1, System ()
s2) -> do
    id1 <- forall (sch :: k).
(HasCallStack, Schedule sch) =>
System () -> System Entity
forall {k} (sch :: k).
(HasCallStack, Schedule sch) =>
System () -> System Entity
systemEntity @sc System ()
s1
    id2 <- systemEntity @sc s2
    insert (Rel Before id2) id1

remove :: forall sc a. (Schedule sc, ToSystems a) => a -> System ()
remove :: forall {k} (sc :: k) a.
(Schedule sc, ToSystems a) =>
a -> System ()
remove a
systems = do
  sch <- forall (sch :: k). Schedule sch => System Entity
forall {k} (sch :: k). Schedule sch => System Entity
scheduleEntity @sc

  let Systems y = collect systems
  for_ y $ \System ()
system -> do
    s <- forall (sc :: k). Schedule sc => System () -> System Entity
forall {k} (sc :: k). Schedule sc => System () -> System Entity
Mischief.ECS.Systems.get @sc System ()
system
    removeSystemFromMap (ScheduleId sch) system

    despawn s

    query (mkQuery' E (With (R @Before s)))
      >>= traverse_ (removeRel @Before s)

order :: forall sc a b. (Schedule sc, ToSystems a, ToSystems b) => (a, b) -> System ()
order :: forall {k} (sc :: k) a b.
(Schedule sc, ToSystems a, ToSystems b) =>
(a, b) -> System ()
order (a
s1, b
s2) = do
  let Systems [System ()]
systems1 = a -> Systems
forall v storage. Collectable v storage => v -> storage
collect a
s1
  let Systems [System ()]
systems2 = b -> Systems
forall v storage. Collectable v storage => v -> storage
collect b
s2

  [System ()] -> (System () -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [System ()]
systems1 ((System () -> System ()) -> System ())
-> (System () -> System ()) -> System ()
forall a b. (a -> b) -> a -> b
$ \System ()
s1 -> [System ()] -> (System () -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [System ()]
systems2 ((System () -> System ()) -> System ())
-> (System () -> System ()) -> System ()
forall a b. (a -> b) -> a -> b
$ \System ()
s2 -> do
    s1 <- forall (sc :: k). Schedule sc => System () -> System Entity
forall {k} (sc :: k). Schedule sc => System () -> System Entity
Mischief.ECS.Systems.get @sc System ()
s1
    s2 <- Mischief.ECS.Systems.get @sc s2

    insert (Rel Before s2) s1

spawn :: System () -> System Entity
spawn :: System () -> System Entity
spawn = SystemFunction -> System Entity
forall b. (HasCallStack, Bundle b) => b -> System Entity
Spawn.spawn (SystemFunction -> System Entity)
-> (System () -> SystemFunction) -> System () -> System Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. System () -> SystemFunction
SystemFunction

get :: forall sc. (Schedule sc) => System () -> System Entity
get :: forall {k} (sc :: k). Schedule sc => System () -> System Entity
get = forall (sch :: k).
(HasCallStack, Schedule sch) =>
System () -> System Entity
forall {k} (sch :: k).
(HasCallStack, Schedule sch) =>
System () -> System Entity
systemEntity @sc

unschedule :: forall sc a. (Schedule sc, ToSystems a) => a -> System ()
unschedule :: forall {k} (sc :: k) a.
(Schedule sc, ToSystems a) =>
a -> System ()
unschedule a
s = do
  sch' <- forall (sch :: k). Schedule sch => System Entity
forall {k} (sch :: k). Schedule sch => System Entity
scheduleEntity @sc

  let Systems systems = collect s
  for_ systems $ \System ()
s -> do
    s' <- forall (sc :: k). Schedule sc => System () -> System Entity
forall {k} (sc :: k). Schedule sc => System () -> System Entity
Mischief.ECS.Systems.get @sc System ()
s

    removeRel @ScheduledIn sch' s'