module Mischief.ECS.World.Par where

import Control.Concurrent (forkIO)
import Control.Concurrent.Async (async, wait)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Foldable
import Data.IORef (modifyIORef', newIORef, readIORef)
import Data.Traversable
import GHC.Conc (numCapabilities)
import Mischief.ECS.Hidden
import Mischief.ECS.World

par :: (MonadSystem w m) => [ParSystem ()] -> m ()
par :: forall w (m :: * -> *). MonadSystem w m => [ParSystem ()] -> m ()
par ![ParSystem ()]
parSystems = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld

  x <- forM parSystems $ \(ParSystem ReaderT ParWorld IO ()
p) -> do
    systems <- IO (IORef [System ()]) -> m (IORef [System ()])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [System ()]) -> m (IORef [System ()]))
-> IO (IORef [System ()]) -> m (IORef [System ()])
forall a b. (a -> b) -> a -> b
$ [System ()] -> IO (IORef [System ()])
forall a. a -> IO (IORef a)
newIORef []
    id <- liftIO $ async $ runReaderT p ParWorld {world = Hidden world, parDeferred = systems}
    return (id, systems)

  for_ x $ \(Async ()
id, IORef [System ()]
systems) -> do
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Async () -> IO ()
forall a. Async a -> IO a
wait Async ()
id
    systems <- IO [System ()] -> m [System ()]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [System ()] -> m [System ()])
-> IO [System ()] -> m [System ()]
forall a b. (a -> b) -> a -> b
$ IORef [System ()] -> IO [System ()]
forall a. IORef a -> IO a
readIORef IORef [System ()]
systems
    liftIO $ modifyIORef' world.deferred (++ systems)

parIterList :: (MonadSystem w m, Foldable t) => t a -> ([a] -> ParSystem b) -> m [b]
parIterList :: forall w (m :: * -> *) (t :: * -> *) a b.
(MonadSystem w m, Foldable t) =>
t a -> ([a] -> ParSystem b) -> m [b]
parIterList !t a
list ![a] -> ParSystem b
s = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld

  let n = Int
numCapabilities
  let len = t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
list

  let chunks = Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
group (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n) (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
list)

  x <- forM chunks $ \[a]
chunk -> do
    systems <- IO (IORef [System ()]) -> m (IORef [System ()])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [System ()]) -> m (IORef [System ()]))
-> IO (IORef [System ()]) -> m (IORef [System ()])
forall a b. (a -> b) -> a -> b
$ [System ()] -> IO (IORef [System ()])
forall a. a -> IO (IORef a)
newIORef []
    let ParSystem p = s chunk
    id <- liftIO $ async $ runReaderT p ParWorld {world = Hidden world, parDeferred = systems}
    return (id, systems)

  for x $ \(Async b
id, IORef [System ()]
systems) -> do
    a <- IO b -> m b
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Async b -> IO b
forall a. Async a -> IO a
wait Async b
id
    systems <- liftIO $ readIORef systems
    liftIO $ modifyIORef' world.deferred (++ systems)
    return a

group :: Int -> [a] -> [[a]]
group :: forall a. Int -> [a] -> [[a]]
group Int
_ [] = []
group Int
0 [a]
l = [[a]
l]
group !Int
n ![a]
l = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
l [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
group Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
l)

parIter :: (MonadSystem w m, Foldable t) => t a -> (a -> ParSystem b) -> m [b]
parIter :: forall w (m :: * -> *) (t :: * -> *) a b.
(MonadSystem w m, Foldable t) =>
t a -> (a -> ParSystem b) -> m [b]
parIter t a
x a -> ParSystem b
s = [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> ([a] -> ParSystem [b]) -> m [[b]]
forall w (m :: * -> *) (t :: * -> *) a b.
(MonadSystem w m, Foldable t) =>
t a -> ([a] -> ParSystem b) -> m [b]
parIterList t a
x ([a] -> (a -> ParSystem b) -> ParSystem [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
`for` a -> ParSystem b
s)

parIter_ :: (MonadSystem w m, Foldable t) => t a -> (a -> ParSystem b) -> m ()
parIter_ :: forall w (m :: * -> *) (t :: * -> *) a b.
(MonadSystem w m, Foldable t) =>
t a -> (a -> ParSystem b) -> m ()
parIter_ t a
x a -> ParSystem b
s = m [()] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (t a -> ([a] -> ParSystem ()) -> m [()]
forall w (m :: * -> *) (t :: * -> *) a b.
(MonadSystem w m, Foldable t) =>
t a -> ([a] -> ParSystem b) -> m [b]
parIterList t a
x ([a] -> (a -> ParSystem b) -> ParSystem ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
`for_` a -> ParSystem b
s))