Defer.hs

module Mischief.ECS.World.Defer where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Foldable
import Data.Functor
import Data.IORef
import GHC.Float (float2Int)
import Mischief.ECS.World

-- | Defer a System. This will put it in the current deferred queue which is typically flushed in-between scheduled systems.
--
-- This is useful for executing mutations in parallel systems.
--
-- You can manually flush the queue with 'flush'.
defer :: (MonadSystem w m) => System a -> m ()
defer s =
  systemAny
    ( do
        world <- unsafeGetWorld
        liftIO $ modifyIORef' world.deferred (++ [s $> ()])
    )
    ( do
        ParWorld {parDeferred = !parDeferred} <- ask
        liftIO $ modifyIORef' parDeferred (++ [s $> ()])
    )

-- | Flush the current list of deferred commands.
flush :: System ()
flush = do
  !world <- unsafeGetWorld
  !systems <- liftIO $ readIORef world.deferred

  for_ systems $ \(!s) -> do
    forkDefer $ do
      s
      flush

  liftIO $ writeIORef world.deferred []

-- | Flush the current list of deferred async commands.
flushAsync :: System ()
flushAsync = do
  !world <- unsafeGetWorld

  !systems <- liftIO $ atomically $ do
    !systems <- readTVar world.deferredAsync
    writeTVar world.deferredAsync []
    pure systems

  for_ systems $ \(!s) -> do
    forkDefer $ do
      s
      flush

forkDefer :: System a -> System a
forkDefer !s = do
  !world <- unsafeGetWorld
  !deferred <- liftIO $ newIORef []

  let !world' = setDeferred deferred world
  !a <- liftIO $ runSystem s world'

  !deferred <- liftIO $ readIORef deferred
  liftIO $ modifyIORef' world.deferred (++ deferred)
  pure a

-- | Run an IO action asynchronously before running a System with its output. Useful when performing significant IO such as reading / loading files.
runAfter :: (MonadSystem w m) => IO a -> (a -> System ()) -> m ()
runAfter !function !system = do
  !world <- unsafeGetWorld
  _ <- liftIO $ forkIO $ do
    !a <- function
    atomically $ modifyTVar' world.deferredAsync (++ [system a])

  pure ()

-- | Delay a system by a given amount of seconds.
--
-- Example:
--
-- @
-- delay 1.5 $ insert (Health 100) player
-- @
delay :: (MonadSystem w m) => Float -> System a -> m ()
delay !d !system = runAfter (threadDelay (float2Int $ 1000000 * d)) (void . const system)