{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Aztecs.ECS.System
-- Copyright   : (c) Matt Hunzinger, 2025
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : matt@hunzinger.me
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Systems to process entities.
module Aztecs.ECS.System
  ( -- * Systems
    System,
    SystemT (..),

    -- ** Reading
    readQuery,
    allDyn,
    readQueryEntities,

    -- ** Writing
    query,
    querySingleMaybe,
    queryDyn,
    querySingleMaybeDyn,

    -- ** Running
    runSystemT,
    concurrently,

    -- * Internal
    Job (..),
    Task (..),
  )
where

import Aztecs.ECS.Entity (EntityID)
import Aztecs.ECS.Query (QueryT (..))
import Aztecs.ECS.Query.Dynamic (DynamicQueryT, queryFilter, readDynQuery, readDynQueryEntities)
import qualified Aztecs.ECS.View as V
import qualified Aztecs.ECS.World.Archetype as A
import Aztecs.ECS.World.Entities (Entities (..))
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Monad.Identity
import Control.Monad.Trans
import Data.Kind
import qualified Data.Map as Map

-- | System task.
--
-- @since 0.11
newtype Task t (m :: Type -> Type) a
  = Task {forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Task t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runTask :: ((Entities -> Entities) -> t m Entities) -> t m a}
  deriving ((forall a b. (a -> b) -> Task t m a -> Task t m b)
-> (forall a b. a -> Task t m b -> Task t m a)
-> Functor (Task t m)
forall a b. a -> Task t m b -> Task t m a
forall a b. (a -> b) -> Task t m a -> Task t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> Task t m b -> Task t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> Task t m a -> Task t m b
$cfmap :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> Task t m a -> Task t m b
fmap :: forall a b. (a -> b) -> Task t m a -> Task t m b
$c<$ :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> Task t m b -> Task t m a
<$ :: forall a b. a -> Task t m b -> Task t m a
Functor)

-- | Job to be interpreted.
--
-- @since 0.11
data Job t m a where
  Pure :: a -> Job t m a
  Map :: (a -> b) -> Job t m a -> Job t m b
  Ap :: Job t m (a -> b) -> Job t m a -> Job t m b
  Bind :: Job t m a -> (a -> Job t m b) -> Job t m b
  Once :: Task t m a -> Job t m a

type System = SystemT Identity

-- | System to process entities.
--
-- @since 0.11
newtype SystemT m a
  = System {forall (m :: * -> *) a.
SystemT m a
-> forall (t :: (* -> *) -> * -> *).
   (MonadTrans t, Monad (t m)) =>
   Job t m a
unSystem :: forall t. (MonadTrans t, Monad (t m)) => Job t m a}

-- | @since 0.11
instance Functor (SystemT m) where
  fmap :: forall a b. (a -> b) -> SystemT m a -> SystemT m b
fmap a -> b
f (System forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m a
s) = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m b)
-> SystemT m b
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m b)
 -> SystemT m b)
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m b)
-> SystemT m b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Job t m a -> Job t m b
forall a b (t :: (* -> *) -> * -> *) (m :: * -> *).
(a -> b) -> Job t m a -> Job t m b
Map a -> b
f Job t m a
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m a
s

-- | @since 0.11
instance (Monad m) => Applicative (SystemT m) where
  pure :: forall a. a -> SystemT m a
pure a
a = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m a)
 -> SystemT m a)
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m a)
-> SystemT m a
forall a b. (a -> b) -> a -> b
$ a -> Job t m a
forall a (t :: (* -> *) -> * -> *) (m :: * -> *). a -> Job t m a
Pure a
a
  (System forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m (a -> b)
f) <*> :: forall a b. SystemT m (a -> b) -> SystemT m a -> SystemT m b
<*> (System forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m a
g) = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m b)
-> SystemT m b
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m b)
 -> SystemT m b)
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m b)
-> SystemT m b
forall a b. (a -> b) -> a -> b
$ Job t m (a -> b) -> Job t m a -> Job t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Job t m (a -> b) -> Job t m a -> Job t m b
Ap Job t m (a -> b)
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m (a -> b)
f Job t m a
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m a
g

-- | @since 0.11
instance (Monad m) => Monad (SystemT m) where
  (System forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m a
a) >>= :: forall a b. SystemT m a -> (a -> SystemT m b) -> SystemT m b
>>= a -> SystemT m b
f = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m b)
-> SystemT m b
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m b)
 -> SystemT m b)
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m b)
-> SystemT m b
forall a b. (a -> b) -> a -> b
$ Job t m a -> (a -> Job t m b) -> Job t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Job t m a -> (a -> Job t m b) -> Job t m b
Bind Job t m a
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m a
a (SystemT m b -> Job t m b
SystemT m b
-> forall (t :: (* -> *) -> * -> *).
   (MonadTrans t, Monad (t m)) =>
   Job t m b
forall (m :: * -> *) a.
SystemT m a
-> forall (t :: (* -> *) -> * -> *).
   (MonadTrans t, Monad (t m)) =>
   Job t m a
unSystem (SystemT m b -> Job t m b) -> (a -> SystemT m b) -> a -> Job t m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SystemT m b
f)

-- | @since 0.11
instance (MonadIO m) => MonadIO (SystemT m) where
  liftIO :: forall a. IO a -> SystemT m a
liftIO IO a
m = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m a)
 -> SystemT m a)
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m a)
-> SystemT m a
forall a b. (a -> b) -> a -> b
$ Task t m a -> Job t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Task t m a -> Job t m a
Once (Task t m a -> Job t m a)
-> (m a -> Task t m a) -> m a -> Job t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Entities -> Entities) -> t m Entities) -> t m a) -> Task t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(((Entities -> Entities) -> t m Entities) -> t m a) -> Task t m a
Task ((((Entities -> Entities) -> t m Entities) -> t m a) -> Task t m a)
-> (m a -> ((Entities -> Entities) -> t m Entities) -> t m a)
-> m a
-> Task t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
forall a b. a -> b -> a
const (t m a -> ((Entities -> Entities) -> t m Entities) -> t m a)
-> (m a -> t m a)
-> m a
-> ((Entities -> Entities) -> t m Entities)
-> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Job t m a) -> m a -> Job t m a
forall a b. (a -> b) -> a -> b
$ IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m

-- | Map all entities with a `DynamicQueryT`.
--
-- @since 0.11
queryDyn :: (Monad m) => DynamicQueryT m a -> SystemT m [a]
queryDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> SystemT m [a]
queryDyn DynamicQueryT m a
q = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m [a])
-> SystemT m [a]
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m [a])
 -> SystemT m [a])
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m [a])
-> SystemT m [a]
forall a b. (a -> b) -> a -> b
$ Task t m [a] -> Job t m [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Task t m a -> Job t m a
Once (Task t m [a] -> Job t m [a])
-> ((((Entities -> Entities) -> t m Entities) -> t m [a])
    -> Task t m [a])
-> (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Job t m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Task t m [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(((Entities -> Entities) -> t m Entities) -> t m a) -> Task t m a
Task ((((Entities -> Entities) -> t m Entities) -> t m [a])
 -> Job t m [a])
-> (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Job t m [a]
forall a b. (a -> b) -> a -> b
$ \(Entities -> Entities) -> t m Entities
f -> do
  Entities
w <- (Entities -> Entities) -> t m Entities
f Entities -> Entities
forall a. a -> a
id
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
      !v :: View
v = QueryFilter -> Archetypes -> View
V.view QueryFilter
qf (Archetypes -> View) -> Archetypes -> View
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
w
  ([a]
o, View
v') <- m ([a], View) -> t m ([a], View)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([a], View) -> t m ([a], View))
-> m ([a], View) -> t m ([a], View)
forall a b. (a -> b) -> a -> b
$ DynamicQueryT m a -> View -> m ([a], View)
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m ([a], View)
V.mapDyn DynamicQueryT m a
q View
v
  Entities
_ <- (Entities -> Entities) -> t m Entities
f ((Entities -> Entities) -> t m Entities)
-> (Entities -> Entities) -> t m Entities
forall a b. (a -> b) -> a -> b
$ View -> Entities -> Entities
V.unview View
v'
  [a] -> t m [a]
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
o

-- | Map a single entity with a `DynamicQueryT`.
--
-- @since 0.11
querySingleMaybeDyn :: (Monad m) => DynamicQueryT m a -> SystemT m (Maybe a)
querySingleMaybeDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> SystemT m (Maybe a)
querySingleMaybeDyn DynamicQueryT m a
q = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m (Maybe a))
-> SystemT m (Maybe a)
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m (Maybe a))
 -> SystemT m (Maybe a))
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m (Maybe a))
-> SystemT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Task t m (Maybe a) -> Job t m (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Task t m a -> Job t m a
Once (Task t m (Maybe a) -> Job t m (Maybe a))
-> ((((Entities -> Entities) -> t m Entities) -> t m (Maybe a))
    -> Task t m (Maybe a))
-> (((Entities -> Entities) -> t m Entities) -> t m (Maybe a))
-> Job t m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Entities -> Entities) -> t m Entities) -> t m (Maybe a))
-> Task t m (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(((Entities -> Entities) -> t m Entities) -> t m a) -> Task t m a
Task ((((Entities -> Entities) -> t m Entities) -> t m (Maybe a))
 -> Job t m (Maybe a))
-> (((Entities -> Entities) -> t m Entities) -> t m (Maybe a))
-> Job t m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(Entities -> Entities) -> t m Entities
f -> do
  Entities
w <- (Entities -> Entities) -> t m Entities
f Entities -> Entities
forall a. a -> a
id
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
  case QueryFilter -> Archetypes -> Maybe View
V.viewSingle QueryFilter
qf (Archetypes -> Maybe View) -> Archetypes -> Maybe View
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
w of
    Just View
v -> do
      (Maybe a
o, View
v') <- m (Maybe a, View) -> t m (Maybe a, View)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe a, View) -> t m (Maybe a, View))
-> m (Maybe a, View) -> t m (Maybe a, View)
forall a b. (a -> b) -> a -> b
$ DynamicQueryT m a -> View -> m (Maybe a, View)
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m (Maybe a, View)
V.mapSingleDyn DynamicQueryT m a
q View
v
      Entities
_ <- (Entities -> Entities) -> t m Entities
f ((Entities -> Entities) -> t m Entities)
-> (Entities -> Entities) -> t m Entities
forall a b. (a -> b) -> a -> b
$ View -> Entities -> Entities
V.unview View
v'
      Maybe a -> t m (Maybe a)
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
o
    Maybe View
Nothing -> Maybe a -> t m (Maybe a)
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | Match and update all entities with a `QueryT`.
--
-- @since 0.11
query :: (Monad m) => QueryT m a -> SystemT m [a]
query :: forall (m :: * -> *) a. Monad m => QueryT m a -> SystemT m [a]
query QueryT m a
q = do
  DynamicQueryT m a
dynQ <- QueryT m a -> SystemT m (DynamicQueryT m a)
forall (m :: * -> *) a.
Monad m =>
QueryT m a -> SystemT m (DynamicQueryT m a)
fromQuery QueryT m a
q
  DynamicQueryT m a -> SystemT m [a]
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> SystemT m [a]
queryDyn DynamicQueryT m a
dynQ

-- | Match and update a single entity with a `QueryT`, or @Nothing@.
--
-- @since 0.11
querySingleMaybe :: (Monad m) => QueryT m a -> SystemT m (Maybe a)
querySingleMaybe :: forall (m :: * -> *) a.
Monad m =>
QueryT m a -> SystemT m (Maybe a)
querySingleMaybe QueryT m a
q = do
  DynamicQueryT m a
dynQ <- QueryT m a -> SystemT m (DynamicQueryT m a)
forall (m :: * -> *) a.
Monad m =>
QueryT m a -> SystemT m (DynamicQueryT m a)
fromQuery QueryT m a
q
  DynamicQueryT m a -> SystemT m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> SystemT m (Maybe a)
querySingleMaybeDyn DynamicQueryT m a
dynQ

-- | Match all entities with a `QueryT`.
--
-- @since 0.11
readQuery :: (Monad m) => QueryT m a -> SystemT m [a]
readQuery :: forall (m :: * -> *) a. Monad m => QueryT m a -> SystemT m [a]
readQuery QueryT m a
q = do
  DynamicQueryT m a
dynQ <- QueryT m a -> SystemT m (DynamicQueryT m a)
forall (m :: * -> *) a.
Monad m =>
QueryT m a -> SystemT m (DynamicQueryT m a)
fromQuery QueryT m a
q
  DynamicQueryT m a -> SystemT m [a]
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> SystemT m [a]
allDyn DynamicQueryT m a
dynQ

-- | Match entities with a `QueryT`.
--
-- @since 0.11
readQueryEntities :: (Monad m) => [EntityID] -> QueryT m a -> SystemT m [a]
readQueryEntities :: forall (m :: * -> *) a.
Monad m =>
[EntityID] -> QueryT m a -> SystemT m [a]
readQueryEntities [EntityID]
es QueryT m a
q = QueryT m a -> SystemT m (DynamicQueryT m a)
forall (m :: * -> *) a.
Monad m =>
QueryT m a -> SystemT m (DynamicQueryT m a)
fromQuery QueryT m a
q SystemT m (DynamicQueryT m a)
-> (DynamicQueryT m a -> SystemT m [a]) -> SystemT m [a]
forall a b. SystemT m a -> (a -> SystemT m b) -> SystemT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [EntityID] -> DynamicQueryT m a -> SystemT m [a]
forall (m :: * -> *) a.
Monad m =>
[EntityID] -> DynamicQueryT m a -> SystemT m [a]
queryEntitiesDyn [EntityID]
es

allDyn :: (Monad m) => DynamicQueryT m a -> SystemT m [a]
allDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> SystemT m [a]
allDyn DynamicQueryT m a
q = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m [a])
-> SystemT m [a]
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m [a])
 -> SystemT m [a])
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m [a])
-> SystemT m [a]
forall a b. (a -> b) -> a -> b
$ Task t m [a] -> Job t m [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Task t m a -> Job t m a
Once (Task t m [a] -> Job t m [a])
-> ((((Entities -> Entities) -> t m Entities) -> t m [a])
    -> Task t m [a])
-> (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Job t m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Task t m [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(((Entities -> Entities) -> t m Entities) -> t m a) -> Task t m a
Task ((((Entities -> Entities) -> t m Entities) -> t m [a])
 -> Job t m [a])
-> (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Job t m [a]
forall a b. (a -> b) -> a -> b
$ \(Entities -> Entities) -> t m Entities
f -> do
  Entities
w <- (Entities -> Entities) -> t m Entities
f Entities -> Entities
forall a. a -> a
id
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
      !v :: View
v = QueryFilter -> Archetypes -> View
V.view QueryFilter
qf (Archetypes -> View) -> Archetypes -> View
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
w
  m [a] -> t m [a]
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [a] -> t m [a]) -> m [a] -> t m [a]
forall a b. (a -> b) -> a -> b
$
    if View -> Bool
V.null View
v
      then DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT m a
q (Archetype -> m [a]) -> Archetype -> m [a]
forall a b. (a -> b) -> a -> b
$ Archetype
A.empty {A.entities = Map.keysSet $ entities w}
      else DynamicQueryT m a -> View -> m [a]
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m [a]
V.allDyn DynamicQueryT m a
q View
v

queryEntitiesDyn :: (Monad m) => [EntityID] -> DynamicQueryT m a -> SystemT m [a]
queryEntitiesDyn :: forall (m :: * -> *) a.
Monad m =>
[EntityID] -> DynamicQueryT m a -> SystemT m [a]
queryEntitiesDyn [EntityID]
es DynamicQueryT m a
q = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m [a])
-> SystemT m [a]
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m [a])
 -> SystemT m [a])
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m [a])
-> SystemT m [a]
forall a b. (a -> b) -> a -> b
$ Task t m [a] -> Job t m [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Task t m a -> Job t m a
Once (Task t m [a] -> Job t m [a])
-> ((((Entities -> Entities) -> t m Entities) -> t m [a])
    -> Task t m [a])
-> (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Job t m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Task t m [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(((Entities -> Entities) -> t m Entities) -> t m a) -> Task t m a
Task ((((Entities -> Entities) -> t m Entities) -> t m [a])
 -> Job t m [a])
-> (((Entities -> Entities) -> t m Entities) -> t m [a])
-> Job t m [a]
forall a b. (a -> b) -> a -> b
$ \(Entities -> Entities) -> t m Entities
f -> do
  Entities
w <- (Entities -> Entities) -> t m Entities
f Entities -> Entities
forall a. a -> a
id
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
      !v :: View
v = QueryFilter -> Archetypes -> View
V.view QueryFilter
qf (Archetypes -> View) -> Archetypes -> View
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
w
  m [a] -> t m [a]
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [a] -> t m [a]) -> m [a] -> t m [a]
forall a b. (a -> b) -> a -> b
$
    if View -> Bool
V.null View
v
      then [EntityID] -> DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
es DynamicQueryT m a
q (Archetype -> m [a]) -> Archetype -> m [a]
forall a b. (a -> b) -> a -> b
$ Archetype
A.empty {A.entities = Map.keysSet $ entities w}
      else DynamicQueryT m a -> View -> m [a]
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> View -> m [a]
V.allDyn DynamicQueryT m a
q View
v

-- | Convert a `QueryT` to a `System`.
--
-- @since 0.11
fromQuery :: (Monad m) => QueryT m a -> SystemT m (DynamicQueryT m a)
fromQuery :: forall (m :: * -> *) a.
Monad m =>
QueryT m a -> SystemT m (DynamicQueryT m a)
fromQuery QueryT m a
q = (forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m (DynamicQueryT m a))
-> SystemT m (DynamicQueryT m a)
forall (m :: * -> *) a.
(forall (t :: (* -> *) -> * -> *).
 (MonadTrans t, Monad (t m)) =>
 Job t m a)
-> SystemT m a
System ((forall (t :: (* -> *) -> * -> *).
  (MonadTrans t, Monad (t m)) =>
  Job t m (DynamicQueryT m a))
 -> SystemT m (DynamicQueryT m a))
-> (forall (t :: (* -> *) -> * -> *).
    (MonadTrans t, Monad (t m)) =>
    Job t m (DynamicQueryT m a))
-> SystemT m (DynamicQueryT m a)
forall a b. (a -> b) -> a -> b
$ Task t m (DynamicQueryT m a) -> Job t m (DynamicQueryT m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Task t m a -> Job t m a
Once (Task t m (DynamicQueryT m a) -> Job t m (DynamicQueryT m a))
-> ((((Entities -> Entities) -> t m Entities)
     -> t m (DynamicQueryT m a))
    -> Task t m (DynamicQueryT m a))
-> (((Entities -> Entities) -> t m Entities)
    -> t m (DynamicQueryT m a))
-> Job t m (DynamicQueryT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Entities -> Entities) -> t m Entities)
 -> t m (DynamicQueryT m a))
-> Task t m (DynamicQueryT m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(((Entities -> Entities) -> t m Entities) -> t m a) -> Task t m a
Task ((((Entities -> Entities) -> t m Entities)
  -> t m (DynamicQueryT m a))
 -> Job t m (DynamicQueryT m a))
-> (((Entities -> Entities) -> t m Entities)
    -> t m (DynamicQueryT m a))
-> Job t m (DynamicQueryT m a)
forall a b. (a -> b) -> a -> b
$ \(Entities -> Entities) -> t m Entities
f -> do
  Entities
w <- (Entities -> Entities) -> t m Entities
f Entities -> Entities
forall a. a -> a
id
  let (Components
cs', DynamicQueryT m a
dynQ) = QueryT m a -> Components -> (Components, DynamicQueryT m a)
forall (f :: * -> *) a.
QueryT f a -> Components -> (Components, DynamicQueryT f a)
runQuery QueryT m a
q (Components -> (Components, DynamicQueryT m a))
-> Components -> (Components, DynamicQueryT m a)
forall a b. (a -> b) -> a -> b
$ Entities -> Components
components Entities
w
  Entities
_ <- (Entities -> Entities) -> t m Entities
f ((Entities -> Entities) -> t m Entities)
-> (Entities -> Entities) -> t m Entities
forall a b. (a -> b) -> a -> b
$ Entities -> Entities -> Entities
forall a b. a -> b -> a
const Entities
w {components = cs'}
  DynamicQueryT m a -> t m (DynamicQueryT m a)
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return DynamicQueryT m a
dynQ

runSystemT :: (MonadTrans t, Monad (t m), Monad m) => SystemT m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runSystemT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
SystemT m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runSystemT (System forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m a
s) = Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runJob Job t m a
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
Job t m a
s

runJob :: (MonadTrans t, Monad (t m), Monad m) => Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runJob :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runJob (Pure a
a) (Entities -> Entities) -> t m Entities
_ = a -> t m a
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
runJob (Map a -> a
f' Job t m a
s') (Entities -> Entities) -> t m Entities
f = a -> a
f' (a -> a) -> t m a -> t m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runJob Job t m a
s' (Entities -> Entities) -> t m Entities
f
runJob (Ap Job t m (a -> a)
f' Job t m a
a) (Entities -> Entities) -> t m Entities
f = Job t m (a -> a)
-> ((Entities -> Entities) -> t m Entities) -> t m (a -> a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runJob Job t m (a -> a)
f' (Entities -> Entities) -> t m Entities
f t m (a -> a) -> t m a -> t m a
forall a b. t m (a -> b) -> t m a -> t m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runJob Job t m a
a (Entities -> Entities) -> t m Entities
f
runJob (Bind Job t m a
a a -> Job t m a
f') (Entities -> Entities) -> t m Entities
f = Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runJob Job t m a
a (Entities -> Entities) -> t m Entities
f t m a -> (a -> t m a) -> t m a
forall a b. t m a -> (a -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a' -> Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a
runJob (a -> Job t m a
f' a
a') (Entities -> Entities) -> t m Entities
f
runJob (Once (Task ((Entities -> Entities) -> t m Entities) -> t m a
t)) (Entities -> Entities) -> t m Entities
f = ((Entities -> Entities) -> t m Entities) -> t m a
t (Entities -> Entities) -> t m Entities
f

concurrently :: SystemT IO a -> ((Entities -> Entities) -> IO Entities) -> IO a
concurrently :: forall a.
SystemT IO a -> ((Entities -> Entities) -> IO Entities) -> IO a
concurrently (System forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t IO)) =>
Job t IO a
s) (Entities -> Entities) -> IO Entities
f = Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
forall a.
Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
runJobConcurrently Job IdentityT IO a
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t IO)) =>
Job t IO a
s (((Entities -> Entities) -> IdentityT IO Entities) -> IO a)
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
forall a b. (a -> b) -> a -> b
$ IO Entities -> IdentityT IO Entities
forall (m :: * -> *) a. Monad m => m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Entities -> IdentityT IO Entities)
-> ((Entities -> Entities) -> IO Entities)
-> (Entities -> Entities)
-> IdentityT IO Entities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entities -> Entities) -> IO Entities
f

runJobConcurrently :: Job IdentityT IO a -> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
runJobConcurrently :: forall a.
Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
runJobConcurrently (Pure a
a) (Entities -> Entities) -> IdentityT IO Entities
_ = a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
runJobConcurrently (Map a -> a
f' Job IdentityT IO a
s') (Entities -> Entities) -> IdentityT IO Entities
f = a -> a
f' (a -> a) -> IO a -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
forall a.
Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
runJobConcurrently Job IdentityT IO a
s' (Entities -> Entities) -> IdentityT IO Entities
f
runJobConcurrently (Ap Job IdentityT IO (a -> a)
f' Job IdentityT IO a
a) (Entities -> Entities) -> IdentityT IO Entities
f = do
  MVar a
aVar <- IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
  MVar (a -> a)
fVar <- IO (MVar (a -> a))
forall a. IO (MVar a)
newEmptyMVar
  ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    a -> a
f'' <- Job IdentityT IO (a -> a)
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO (a -> a)
forall a.
Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
runJobConcurrently Job IdentityT IO (a -> a)
f' (Entities -> Entities) -> IdentityT IO Entities
f
    MVar (a -> a) -> (a -> a) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (a -> a)
fVar a -> a
f''
  ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    a
a' <- Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
forall a.
Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
runJobConcurrently Job IdentityT IO a
a (Entities -> Entities) -> IdentityT IO Entities
f
    MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
aVar a
a'
  a
a' <- MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
aVar
  a -> a
f'' <- MVar (a -> a) -> IO (a -> a)
forall a. MVar a -> IO a
takeMVar MVar (a -> a)
fVar
  a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ a -> a
f'' a
a'
runJobConcurrently (Bind Job IdentityT IO a
a a -> Job IdentityT IO a
f') (Entities -> Entities) -> IdentityT IO Entities
f = Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
forall a.
Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
runJobConcurrently Job IdentityT IO a
a (Entities -> Entities) -> IdentityT IO Entities
f IO a -> (a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a' -> Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
forall a.
Job IdentityT IO a
-> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a
runJobConcurrently (a -> Job IdentityT IO a
f' a
a') (Entities -> Entities) -> IdentityT IO Entities
f
runJobConcurrently (Once (Task ((Entities -> Entities) -> IdentityT IO Entities) -> IdentityT IO a
t)) (Entities -> Entities) -> IdentityT IO Entities
f = IdentityT IO a -> IO a
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (IdentityT IO a -> IO a) -> IdentityT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ ((Entities -> Entities) -> IdentityT IO Entities) -> IdentityT IO a
t (Entities -> Entities) -> IdentityT IO Entities
f