{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.App.Systems where

import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Default
import Data.Foldable
import Data.IORef
import Data.Map (Map)
import Data.Map qualified as Map
import GHC.Generics
import GHC.StableName (StableName, eqStableName, hashStableName, makeStableName)
import GHC.Stack.Types
import Mischief.ECS.App.Schedules
import Mischief.ECS.App.SystemDef
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Required
import Mischief.ECS.Entities
import Mischief.ECS.Log
import Mischief.ECS.Relationships.Order
import Mischief.ECS.Resources
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.Spawn

newtype Systems = Systems
  { Systems
-> IORef
     (Map
        (ScheduleId, Int) (IORef [(StableName (System ()), SystemId)]))
systemMap :: IORef (Map (ScheduleId, Int) (IORef [(StableName (System ()), SystemId)]))
  }
  deriving anyclass (Typeable Systems
Set DefaultComponentType
Hooks Systems
IsExclusive (RelExclusivity Systems)
(Typeable Systems, IsExclusive (RelExclusivity Systems)) =>
Set DefaultComponentType -> Hooks Systems -> Component Systems
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks Systems
hooks :: Hooks Systems
Component)

newtype SystemFunction = SystemFunction {SystemFunction -> System ()
inner :: System ()}

instance Component SystemFunction where
  required :: Set DefaultComponentType
required = forall b. RequiredBundle b => Set DefaultComponentType
forall {k} (b :: k). RequiredBundle b => Set DefaultComponentType
require @(SystemTick, LastSystemTick)

newSystems :: IO Systems
newSystems :: IO Systems
newSystems = do
  systemMap <- Map (ScheduleId, Int) (IORef [(StableName (System ()), SystemId)])
-> IO
     (IORef
        (Map
           (ScheduleId, Int) (IORef [(StableName (System ()), SystemId)])))
forall a. a -> IO (IORef a)
newIORef Map (ScheduleId, Int) (IORef [(StableName (System ()), SystemId)])
forall k a. Map k a
Map.empty
  return Systems {systemMap}

getSystemId' :: (HasCallStack) => ScheduleId -> System () -> StableName (System ()) -> IORef [(StableName (System ()), SystemId)] -> System SystemId
getSystemId' :: HasCallStack =>
ScheduleId
-> System ()
-> StableName (System ())
-> IORef [(StableName (System ()), SystemId)]
-> System SystemId
getSystemId' ScheduleId
schedule System ()
system StableName (System ())
stableName IORef [(StableName (System ()), SystemId)]
list = do
  list' <- IO [(StableName (System ()), SystemId)]
-> System [(StableName (System ()), SystemId)]
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(StableName (System ()), SystemId)]
 -> System [(StableName (System ()), SystemId)])
-> IO [(StableName (System ()), SystemId)]
-> System [(StableName (System ()), SystemId)]
forall a b. (a -> b) -> a -> b
$ IORef [(StableName (System ()), SystemId)]
-> IO [(StableName (System ()), SystemId)]
forall a. IORef a -> IO a
readIORef IORef [(StableName (System ()), SystemId)]
list
  case find (\(StableName (System ()), SystemId)
x -> (StableName (System ()), SystemId) -> StableName (System ())
forall a b. (a, b) -> a
fst (StableName (System ()), SystemId)
x StableName (System ()) -> StableName (System ()) -> Bool
forall a b. StableName a -> StableName b -> Bool
`eqStableName` StableName (System ())
stableName) list' of
    Just (StableName (System ())
_, SystemId
x) -> SystemId -> System SystemId
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return SystemId
x
    Maybe (StableName (System ()), SystemId)
Nothing -> do
      index <- (SystemFunction, Rel ScheduledIn) -> System Entity
forall b. (HasCallStack, Bundle b) => b -> System Entity
spawn (System () -> SystemFunction
SystemFunction System ()
system, ScheduledIn -> Entity -> Rel ScheduledIn
forall c. c -> Entity -> Rel c
Rel ScheduledIn
ScheduledIn ScheduleId
schedule.id)
      liftIO $ modifyIORef' list (++ [(stableName, SystemId index)])
      return $ SystemId index

getSystemId :: (HasCallStack) => ScheduleId -> System () -> System SystemId
getSystemId :: HasCallStack => ScheduleId -> System () -> System SystemId
getSystemId ScheduleId
sch System ()
system = do
  Systems {systemMap} <- Maybe Systems -> Systems
forall a. HasCallStack => Maybe a -> a
unwrap (Maybe Systems -> Systems)
-> System (Maybe Systems) -> System Systems
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall c. QueryType c => System (Maybe c)
res @Systems)

  stableName <- liftIO $ makeStableName system
  systemMap' <- liftIO $ readIORef systemMap

  case Map.lookup (sch, hashStableName stableName) systemMap' of
    Just IORef [(StableName (System ()), SystemId)]
x -> HasCallStack =>
ScheduleId
-> System ()
-> StableName (System ())
-> IORef [(StableName (System ()), SystemId)]
-> System SystemId
ScheduleId
-> System ()
-> StableName (System ())
-> IORef [(StableName (System ()), SystemId)]
-> System SystemId
getSystemId' ScheduleId
sch System ()
system StableName (System ())
stableName IORef [(StableName (System ()), SystemId)]
x
    Maybe (IORef [(StableName (System ()), SystemId)])
Nothing -> do
      l <- IO (IORef [(StableName (System ()), SystemId)])
-> System (IORef [(StableName (System ()), SystemId)])
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [(StableName (System ()), SystemId)])
 -> System (IORef [(StableName (System ()), SystemId)]))
-> IO (IORef [(StableName (System ()), SystemId)])
-> System (IORef [(StableName (System ()), SystemId)])
forall a b. (a -> b) -> a -> b
$ [(StableName (System ()), SystemId)]
-> IO (IORef [(StableName (System ()), SystemId)])
forall a. a -> IO (IORef a)
newIORef []
      liftIO $ modifyIORef' systemMap (Map.insert (sch, hashStableName stableName) l)
      getSystemId' sch system stableName l

removeSystemFromMap' :: StableName (System ()) -> IORef [(StableName (System ()), SystemId)] -> System ()
removeSystemFromMap' :: StableName (System ())
-> IORef [(StableName (System ()), SystemId)] -> System ()
removeSystemFromMap' StableName (System ())
stableName IORef [(StableName (System ()), SystemId)]
list = do
  IO () -> System ()
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> System ()) -> IO () -> System ()
forall a b. (a -> b) -> a -> b
$ IORef [(StableName (System ()), SystemId)]
-> ([(StableName (System ()), SystemId)]
    -> [(StableName (System ()), SystemId)])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [(StableName (System ()), SystemId)]
list (([(StableName (System ()), SystemId)]
  -> [(StableName (System ()), SystemId)])
 -> IO ())
-> ([(StableName (System ()), SystemId)]
    -> [(StableName (System ()), SystemId)])
-> IO ()
forall a b. (a -> b) -> a -> b
$ ((StableName (System ()), SystemId) -> Bool)
-> [(StableName (System ()), SystemId)]
-> [(StableName (System ()), SystemId)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(StableName (System ()), SystemId)
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (StableName (System ()), SystemId) -> StableName (System ())
forall a b. (a, b) -> a
fst (StableName (System ()), SystemId)
x StableName (System ()) -> StableName (System ()) -> Bool
forall a b. StableName a -> StableName b -> Bool
`eqStableName` StableName (System ())
stableName)

removeSystemFromMap :: ScheduleId -> System () -> System ()
removeSystemFromMap :: ScheduleId -> System () -> System ()
removeSystemFromMap ScheduleId
sch System ()
system = do
  Systems {systemMap} <- Maybe Systems -> Systems
forall a. HasCallStack => Maybe a -> a
unwrap (Maybe Systems -> Systems)
-> System (Maybe Systems) -> System Systems
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall c. QueryType c => System (Maybe c)
res @Systems)

  stableName <- liftIO $ makeStableName system
  systemMap' <- liftIO $ readIORef systemMap

  forM_
    (Map.lookup (sch, hashStableName stableName) systemMap')
    (removeSystemFromMap' stableName)

systemEntity :: (HasCallStack, Schedule sch) => sch -> System () -> System Entity
systemEntity :: forall sch.
(HasCallStack, Schedule sch) =>
sch -> System () -> System Entity
systemEntity sch
sch System ()
s = do
  schId <- sch -> System Entity
forall sch. Schedule sch => sch -> System Entity
scheduleEntity sch
sch
  x <- getSystemId (ScheduleId schId) s
  return x.id

self :: forall m w. (MonadSystem w m) => m Entity
self :: forall (m :: * -> *) w. MonadSystem w m => m Entity
self = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let (SystemId sys) = world.systemId
  return sys

data ScheduledIn = ScheduledIn deriving (Typeable ScheduledIn
Set DefaultComponentType
Hooks ScheduledIn
IsExclusive (RelExclusivity ScheduledIn)
(Typeable ScheduledIn, IsExclusive (RelExclusivity ScheduledIn)) =>
Set DefaultComponentType
-> Hooks ScheduledIn -> Component ScheduledIn
forall c.
(Typeable c, IsExclusive (RelExclusivity c)) =>
Set DefaultComponentType -> Hooks c -> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$chooks :: Hooks ScheduledIn
hooks :: Hooks ScheduledIn
Component)

getSystemTicks :: World -> IO (Tick, Tick)
getSystemTicks :: World -> IO (Tick, Tick)
getSystemTicks World
world = do
  let (SystemId Entity
sys) = World
world.systemId
  System (Tick, Tick) -> World -> IO (Tick, Tick)
forall a. System a -> World -> IO a
runSystem
    ( do
        Just (a, b) <- (C LastSystemTick, C SystemTick)
-> Entity
-> System (Maybe (Result LastSystemTick, Result SystemTick))
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 @LastSystemTick, forall a. C a
forall {k} (a :: k). C a
C @SystemTick) Entity
sys
        return (a.inner, b.inner)
    )
    World
world