module Mischief.ECS.World.Par where

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))