{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Mischief.ECS.World.Query where

import Control.Monad
import Control.Monad.IO.Class
import Data.Data
import Data.Foldable
import Data.Foldable hiding (and)
import Data.IORef
import Data.Map qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import GHC.Base (Int (..), eqWord#, isTrue#)
import Mischief.ECS.App.SystemDef
import Mischief.ECS.Archetypes.Graph
import Mischief.ECS.Collectable
import Mischief.ECS.Components
import Mischief.ECS.Components.BundleTypes
import Mischief.ECS.Components.Common
import Mischief.ECS.Entities
import Mischief.ECS.EntityDef
import Mischief.ECS.Log
import Mischief.ECS.Tables
import Mischief.ECS.Vec qualified as Vec
import Mischief.ECS.World
import Mischief.ECS.World.Query.QueryFilter
import Mischief.ECS.World.Query.Queryable
import Mischief.ECS.World.Query.Val
import Mischief.ECS.World.Utils
import Prelude hiding (and)

runQuery :: forall qd m w output. (Queryable qd output, MonadSystem w m) => qd -> QueryFilter -> World -> m [output]
runQuery :: forall qd (m :: * -> *) w output.
(Queryable qd output, MonadSystem w m) =>
qd -> QueryFilter -> World -> m [output]
runQuery qd
query QueryFilter
filter World
world =
  do
    components <-
      IO [Maybe (ComponentId, ComponentQuery)]
-> m [Maybe (ComponentId, ComponentQuery)]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Maybe (ComponentId, ComponentQuery)]
 -> m [Maybe (ComponentId, ComponentQuery)])
-> IO [Maybe (ComponentId, ComponentQuery)]
-> m [Maybe (ComponentId, ComponentQuery)]
forall a b. (a -> b) -> a -> b
$
        ((TypeRep, TypeQuery) -> IO (Maybe (ComponentId, ComponentQuery)))
-> [(TypeRep, TypeQuery)]
-> IO [Maybe (ComponentId, ComponentQuery)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
          ( \(TypeRep
c, TypeQuery
t) -> do
              c <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
c World
world.components
              return $
                fmap
                  ( \ComponentId
c ->
                      case TypeQuery
t of
                        TypeQuery
CompQ -> (ComponentId
c, ComponentQuery
ComponentQuery)
                        TypeQuery
RelQ -> (ComponentId
c, ComponentQuery
RelationshipQueryAny)
                        RelQ' Entity
entity -> (Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
entity) ComponentId
c, ComponentQuery
RelationshipQuery)
                  )
                  c
          )
          (Set (TypeRep, TypeQuery) -> [(TypeRep, TypeQuery)]
forall a. Set a -> [a]
Set.toList (qd -> Set (TypeRep, TypeQuery)
forall qd output.
Queryable qd output =>
qd -> Set (TypeRep, TypeQuery)
queryTypes qd
query))
    archetypes <- findMatchingArchetypes (catMaybes components) world.archetypes
    let (otherFilter, archetypeFilter) = extractArchetypeFilters $ preprocessFilter filter

    archetypes' <- filterM (\([ComponentId]
components, ArchetypeId
_) -> IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (QueryFilter -> [ComponentId] -> World -> IO Bool
filterArchetype (QueryFilter -> [ComponentId] -> World -> IO Bool)
-> (QueryFilter -> QueryFilter)
-> QueryFilter
-> [ComponentId]
-> World
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryFilter -> QueryFilter
preprocessFilter) QueryFilter
archetypeFilter [ComponentId]
components World
world) archetypes

    outputs <- liftIO $ runQueryInternal query (map snd archetypes') world
    outputs' <- filterM (\(Entity
e, Bool
b, output
_) -> (Bool -> Bool -> Bool
&& Bool
b) (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
filterQuery (QueryFilter -> QueryFilter
preprocessFilter QueryFilter
otherFilter) Entity
e) outputs
    return $ map (\(Entity
_, Bool
_, output
o) -> output
o) outputs'

query :: forall qd output m w. (Queryable qd output, MonadSystem w m) => qd -> m [output]
query :: forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> m [output]
query qd
qd = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  runQuery qd NoFilter world

entityQuery :: forall qd output m w. (Queryable qd output, MonadSystem w m) => qd -> Entity -> m (Maybe output)
entityQuery :: forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> Entity -> m (Maybe output)
entityQuery qd
qd Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  liftIO $ runQueryEntity qd world entity

get :: forall qd m w out. (Queryable qd out, MonadSystem w m) => qd -> Entity -> m (Maybe out)
get :: forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get = qd -> Entity -> m (Maybe out)
forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> Entity -> m (Maybe output)
entityQuery

get' :: forall qd m w out qf. (Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) => qd -> qf -> Entity -> m (Maybe out)
get' :: forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> Entity -> m (Maybe out)
get' qd
qd qf
qf Entity
entity = do
  b <- QueryFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
filterQuery (QueryFilter -> QueryFilter
preprocessFilter (QueryFilter -> QueryFilter) -> QueryFilter -> QueryFilter
forall a b. (a -> b) -> a -> b
$ qf -> QueryFilter
forall v storage. Collectable v storage => v -> storage
collect qf
qf) Entity
entity
  if b
    then
      entityQuery qd entity
    else
      pure Nothing

query' :: forall qd m w out qf. (Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) => qd -> qf -> m [out]
query' :: forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> m [out]
query' qd
qd qf
filter = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  runQuery qd (collect filter) world

single :: forall qd m w out. (Queryable qd out, MonadSystem w m) => qd -> m (Maybe out)
single :: forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> m (Maybe out)
single qd
qd = do
  res <- qd -> m [out]
forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> m [output]
query qd
qd
  case res of
    [out
x] -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe out -> m (Maybe out)) -> Maybe out -> m (Maybe out)
forall a b. (a -> b) -> a -> b
$ out -> Maybe out
forall a. a -> Maybe a
Just out
x
    [out]
_ -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe out
forall a. Maybe a
Nothing

single' :: forall qd m w out qf. (Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) => qd -> qf -> m (Maybe out)
single' :: forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> m (Maybe out)
single' qd
qd qf
filter = do
  res <- qd -> qf -> m [out]
forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> m [out]
query' qd
qd qf
filter
  case res of
    [out
x] -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe out -> m (Maybe out)) -> Maybe out -> m (Maybe out)
forall a b. (a -> b) -> a -> b
$ out -> Maybe out
forall a. a -> Maybe a
Just out
x
    [out]
_ -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe out
forall a. Maybe a
Nothing

-- iter :: forall qd m w. (Queryable qd, MonadSystem w m) => (QueryOutput qd -> m ()) -> m ()
-- iter system = do
--   res <- query @qd
--   for_ res system

-- iter' :: forall qd m w. (Queryable qd, MonadSystem w m) => QueryFilter -> (QueryOutput qd -> m ()) -> m ()
-- iter' filter system = do
--   res <- query' @qd filter
--   for_ res system

-- parIter :: forall qd m w. (Queryable qd, MonadSystem w m) => (QueryOutput qd -> ParSystem ()) -> m ()
-- parIter system = do
--   res <- query @qd
--   parIterList res $ \chunk -> for_ chunk system

filterQuery :: (MonadSystem w m) => QueryFilter -> Entity -> m Bool
filterQuery :: forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
filterQuery QueryFilter
NoFilter Entity
_ = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
filterQuery (QFWith (TypeRep
x, Maybe Entity
Nothing)) Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  comp <- liftIO $ getComponentId x world.components
  case comp of
    Maybe ComponentId
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just (ComponentId (# Word#
id, Maybe Entity
_ #)) -> do
      Just (ComponentType (_ :: Proxy a)) <- Val (C ComponentType) -> Entity -> m (Maybe ComponentType)
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (C ComponentType -> Val (C ComponentType)
forall a. a -> Val a
Val (forall a. C a
forall {k} (a :: k). C a
C @ComponentType)) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
      a <- get (Has @a) entity
      pure $ fromMaybe False a
filterQuery (QFWith (TypeRep
x, Just Entity
e)) Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  comp <- liftIO $ getComponentId x world.components
  case comp of
    Maybe ComponentId
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just (ComponentId (# Word#
id, Maybe Entity
_ #)) -> do
      Just (ComponentType (_ :: Proxy a)) <- Val (C ComponentType) -> Entity -> m (Maybe ComponentType)
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (C ComponentType -> Val (C ComponentType)
forall a. a -> Val a
Val (forall a. C a
forall {k} (a :: k). C a
C @ComponentType)) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
      a <- get (HasR @a e) entity
      pure $ fromMaybe False a
filterQuery (QFWithRelAny TypeRep
x) Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  comp <- liftIO $ getComponentId x world.components
  case comp of
    Maybe ComponentId
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just (ComponentId (# Word#
id, Maybe Entity
_ #)) -> do
      Just (ComponentType (_ :: Proxy a)) <- Val (C ComponentType) -> Entity -> m (Maybe ComponentType)
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (C ComponentType -> Val (C ComponentType)
forall a. a -> Val a
Val (forall a. C a
forall {k} (a :: k). C a
C @ComponentType)) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
      a <- get (HasR @a Any) entity
      pure $ fromMaybe False a
filterQuery (QFChanged (TypeRep
x, Maybe Entity
Nothing) ComponentTicks -> Tick -> Tick -> Bool
f) Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  comp <- liftIO $ getComponentId x world.components
  case comp of
    Maybe ComponentId
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just ComponentId
comp -> do
      (ComponentTicks -> Tick -> Tick -> Bool)
-> ComponentId -> Entity -> m Bool
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentTicks -> Tick -> Tick -> Bool)
-> ComponentId -> Entity -> m Bool
addedChanged' ComponentTicks -> Tick -> Tick -> Bool
f ComponentId
comp Entity
entity
filterQuery (QFChanged (TypeRep
x, Just Entity
e) ComponentTicks -> Tick -> Tick -> Bool
f) Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  comp <- liftIO $ getComponentId x world.components
  case comp of
    Maybe ComponentId
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just ComponentId
comp -> do
      (ComponentTicks -> Tick -> Tick -> Bool)
-> ComponentId -> Entity -> m Bool
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentTicks -> Tick -> Tick -> Bool)
-> ComponentId -> Entity -> m Bool
addedChanged' ComponentTicks -> Tick -> Tick -> Bool
f (Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e) ComponentId
comp) Entity
entity
filterQuery (QFChangedRelAny TypeRep
x ComponentTicks -> Tick -> Tick -> Bool
f) Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  comp <- liftIO $ getComponentId x world.components
  case comp of
    Maybe ComponentId
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just (ComponentId (# Word#
id, Maybe Entity
_ #)) -> do
      components <- IO (Maybe [ComponentId]) -> m (Maybe [ComponentId])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [ComponentId]) -> m (Maybe [ComponentId]))
-> IO (Maybe [ComponentId]) -> m (Maybe [ComponentId])
forall a b. (a -> b) -> a -> b
$ World -> Entity -> IO (Maybe [ComponentId])
findComponentsOfEntity World
world Entity
entity
      case components of
        Maybe [ComponentId]
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Just [ComponentId]
components' -> do
          let components :: [ComponentId]
components = (ComponentId -> Bool) -> [ComponentId] -> [ComponentId]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ComponentId (# Word#
id', Maybe Entity
a #)) -> Maybe Entity -> Bool
forall a. Maybe a -> Bool
isJust Maybe Entity
a Bool -> Bool -> Bool
&& Int# -> Bool
isTrue# (Word# -> Word# -> Int#
eqWord# Word#
id Word#
id')) [ComponentId]
components'
          [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ComponentId -> m Bool) -> [ComponentId] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ComponentId
c -> (ComponentTicks -> Tick -> Tick -> Bool)
-> ComponentId -> Entity -> m Bool
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentTicks -> Tick -> Tick -> Bool)
-> ComponentId -> Entity -> m Bool
addedChanged' ComponentTicks -> Tick -> Tick -> Bool
f ComponentId
c Entity
entity) [ComponentId]
components
filterQuery (QFCheckRaw (TypeRep
_, Maybe Entity
Nothing, ErasedCheck (c -> Bool
f :: (c -> Bool)))) Entity
entity = do
  a <- C c -> Entity -> m (Maybe (Result c))
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 @c) Entity
entity
  pure $ case a of
    Maybe (Result c)
Nothing -> Bool
False
    Just Result c
a -> c -> Bool
f (c -> Bool) -> c -> Bool
forall a b. (a -> b) -> a -> b
$ Result c -> c
forall c. Result c -> c
value Result c
a
filterQuery (QFCheckRaw (TypeRep
_, Just Entity
e, ErasedCheck (c -> Bool
f :: (c -> Bool)))) Entity
entity = do
  a <- R c Entity -> Entity -> m (Maybe (Result (Rel c)))
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (forall {k} (a :: k) b. b -> R a b
forall a b. b -> R a b
R @c Entity
e) Entity
entity
  pure $ case a of
    Maybe (Result (Rel c))
Nothing -> Bool
False
    Just Result (Rel c)
a -> c -> Bool
f Result (Rel c)
a.comp
filterQuery (QFCheckRawRelAny (TypeRep
_, ErasedCheck (c -> Bool
f :: (c -> Bool)))) Entity
entity = do
  a <- R' c Any -> Entity -> m (Maybe [Result (Rel c)])
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (forall {k} (a :: k) b. b -> R' a b
forall a b. b -> R' a b
R' @c Any
Any) Entity
entity
  pure $ case a of
    Maybe [Result (Rel c)]
Nothing -> Bool
False
    Just [Result (Rel c)]
a -> (Result (Rel c) -> Bool) -> [Result (Rel c)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Result (Rel c)
x -> c -> Bool
f Result (Rel c)
x.comp) [Result (Rel c)]
a
filterQuery (QueryFilter
a `QFAnd` QueryFilter
b) Entity
entity = do
  a <- QueryFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
filterQuery QueryFilter
a Entity
entity
  b <- filterQuery b entity
  pure $ a && b
filterQuery (QueryFilter
a `QFOr` QueryFilter
b) Entity
entity = do
  a <- QueryFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
filterQuery QueryFilter
a Entity
entity
  b <- filterQuery b entity
  pure $ a || b
filterQuery (QFNot QueryFilter
a) Entity
entity = do
  a <- QueryFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
filterQuery QueryFilter
a Entity
entity
  pure $ not a

filterCheckRelAny :: forall qd out. (Queryable qd out) => World -> [ArchetypeId] -> ErasedCheck -> IO ((Int, (Entity, out)) -> IO Bool)
filterCheckRelAny :: forall qd out.
Queryable qd out =>
World
-> [ArchetypeId]
-> ErasedCheck
-> IO ((Int, (Entity, out)) -> IO Bool)
filterCheckRelAny World
world [ArchetypeId]
archetypes (ErasedCheck (c -> Bool
f :: (c -> Bool))) = do
  components <- forall c.
Component c =>
World -> [ArchetypeId] -> IO [(Entity, [Result (Rel c)])]
tryGetRelCollections @c World
world [ArchetypeId]
archetypes

  return $
    \(Int
index, (Entity, out)
_) -> do
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Result (Rel c) -> Bool) -> [Result (Rel c)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (c -> Bool
f (c -> Bool) -> (Result (Rel c) -> c) -> Result (Rel c) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Result (Rel c)
x -> Result (Rel c)
x.comp)) ((Entity, [Result (Rel c)]) -> [Result (Rel c)]
forall a b. (a, b) -> b
snd ((Entity, [Result (Rel c)]) -> [Result (Rel c)])
-> (Entity, [Result (Rel c)]) -> [Result (Rel c)]
forall a b. (a -> b) -> a -> b
$ [(Entity, [Result (Rel c)])]
components [(Entity, [Result (Rel c)])] -> Int -> (Entity, [Result (Rel c)])
forall a. HasCallStack => [a] -> Int -> a
!! Int
index)

filterCheck :: forall qd out. (Queryable qd out) => World -> [ArchetypeId] -> ComponentId -> ErasedCheck -> IO ((Int, (Entity, out)) -> IO Bool)
filterCheck :: forall qd out.
Queryable qd out =>
World
-> [ArchetypeId]
-> ComponentId
-> ErasedCheck
-> IO ((Int, (Entity, out)) -> IO Bool)
filterCheck World
world [ArchetypeId]
archetypes ComponentId
id (ErasedCheck (c -> Bool
f :: (c -> Bool))) = do
  components <- forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Result c)]
tryGetComponentsFromTables @c World
world.tables [ArchetypeId]
archetypes ComponentId
id
  return $
    \(Int
index, (Entity, out)
_) ->
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ c -> Bool
f (Result c -> c
forall c. Result c -> c
value (Result c -> c)
-> ((Entity, Result c) -> Result c) -> (Entity, Result c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity, Result c) -> Result c
forall a b. (a, b) -> b
snd ((Entity, Result c) -> c) -> (Entity, Result c) -> c
forall a b. (a -> b) -> a -> b
$ [(Entity, Result c)]
components [(Entity, Result c)] -> Int -> (Entity, Result c)
forall a. HasCallStack => [a] -> Int -> a
!! Int
index)

findComponentsOfEntity :: World -> Entity -> IO (Maybe [ComponentId])
findComponentsOfEntity :: World -> Entity -> IO (Maybe [ComponentId])
findComponentsOfEntity World
world Entity
entity = do
  pointer <- IO (Maybe (IORef EntityPointer))
-> IO (Maybe (IORef EntityPointer))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (IORef EntityPointer))
 -> IO (Maybe (IORef EntityPointer)))
-> IO (Maybe (IORef EntityPointer))
-> IO (Maybe (IORef EntityPointer))
forall a b. (a -> b) -> a -> b
$ Entity -> Entities -> IO (Maybe (IORef EntityPointer))
getPointer Entity
entity World
world.entities

  case pointer of
    Maybe (IORef EntityPointer)
Nothing -> Maybe [ComponentId] -> IO (Maybe [ComponentId])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [ComponentId]
forall a. Maybe a
Nothing
    Just IORef EntityPointer
x -> do
      (EntityPointer (# archetypeId, _ #)) <- IO EntityPointer -> IO EntityPointer
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntityPointer -> IO EntityPointer)
-> IO EntityPointer -> IO EntityPointer
forall a b. (a -> b) -> a -> b
$ IORef EntityPointer -> IO EntityPointer
forall a. IORef a -> IO a
readIORef IORef EntityPointer
x

      x <- Vec.read world.tables.inner (I# archetypeId)

      pure $ Just x.components

class GetResultComponentId c where
  getResultComponentId :: (MonadSystem w m) => c -> m (Maybe ComponentId)

class GetResultComponentId' flag c where
  getResultComponentId' :: (MonadSystem w m) => c -> m (Maybe ComponentId)

instance (Component c) => GetResultComponentId' True (Result c) where
  getResultComponentId' :: forall w (m :: * -> *).
MonadSystem w m =>
Result c -> m (Maybe ComponentId)
getResultComponentId' Result c
_ = (Entity -> ComponentId) -> Maybe Entity -> Maybe ComponentId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Entity (# Word#
id, Word#
_ #)) -> (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
id, Maybe Entity
forall a. Maybe a
Nothing #)) (Maybe Entity -> Maybe ComponentId)
-> m (Maybe Entity) -> m (Maybe ComponentId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
m (Maybe Entity)
tryMetaLocal @c

instance (Component c) => GetResultComponentId' False (Result (Rel c)) where
  getResultComponentId' :: forall w (m :: * -> *).
MonadSystem w m =>
Result (Rel c) -> m (Maybe ComponentId)
getResultComponentId' Result (Rel c)
r = (Entity -> ComponentId) -> Maybe Entity -> Maybe ComponentId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Entity (# Word#
id, Word#
_ #)) -> (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
id, Entity -> Maybe Entity
forall a. a -> Maybe a
Just Result (Rel c)
r.target #)) (Maybe Entity -> Maybe ComponentId)
-> m (Maybe Entity) -> m (Maybe ComponentId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
m (Maybe Entity)
tryMetaLocal @c

tryMetaLocal :: forall c m w. (Component c, MonadSystem w m) => m (Maybe Entity)
tryMetaLocal :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
m (Maybe Entity)
tryMetaLocal = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  component <- liftIO $ getComponentId (typeRep $ Proxy @c) world.components
  return $ fmap (\(ComponentId (# Word#
id, Maybe Entity
_ #)) -> (# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #)) component

instance (GetResultComponentId' (IsComp c) (Result c)) => GetResultComponentId (Result c) where
  getResultComponentId :: forall w (m :: * -> *).
MonadSystem w m =>
Result c -> m (Maybe ComponentId)
getResultComponentId = forall (flag :: Bool) c w (m :: * -> *).
(GetResultComponentId' flag c, MonadSystem w m) =>
c -> m (Maybe ComponentId)
forall {k} (flag :: k) c w (m :: * -> *).
(GetResultComponentId' flag c, MonadSystem w m) =>
c -> m (Maybe ComponentId)
getResultComponentId' @(IsComp c)

addedChanged' :: forall m w. (MonadSystem w m) => (ComponentTicks -> Tick -> Tick -> Bool) -> ComponentId -> Entity -> m Bool
addedChanged' :: forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentTicks -> Tick -> Tick -> Bool)
-> ComponentId -> Entity -> m Bool
addedChanged' ComponentTicks -> Tick -> Tick -> Bool
f ComponentId
id Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  ticks <- liftIO $ tryGetEntityTicks entity id world
  case ticks of
    Maybe ComponentTicks
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just ComponentTicks
ticks -> do
      (lastSystemTick, currentSystemTick) <- IO (Tick, Tick) -> m (Tick, Tick)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tick, Tick) -> m (Tick, Tick))
-> IO (Tick, Tick) -> m (Tick, Tick)
forall a b. (a -> b) -> a -> b
$ World -> IO (Tick, Tick)
getSystemTicksInternal World
world
      return $ f ticks lastSystemTick currentSystemTick

addedChanged :: forall c m w. (MonadSystem w m, GetResultComponentId (Result c)) => (ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
addedChanged :: forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
(ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
f Result c
r = do
  id <- Result c -> m (Maybe ComponentId)
forall c w (m :: * -> *).
(GetResultComponentId c, MonadSystem w m) =>
c -> m (Maybe ComponentId)
forall w (m :: * -> *).
MonadSystem w m =>
Result c -> m (Maybe ComponentId)
getResultComponentId Result c
r
  case id of
    Maybe ComponentId
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just ComponentId
id -> do
      world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
      ticks <- liftIO $ tryGetEntityTicks (entityOf r) id world
      case ticks of
        Maybe ComponentTicks
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just ComponentTicks
ticks -> do
          (lastSystemTick, currentSystemTick) <- IO (Tick, Tick) -> m (Tick, Tick)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tick, Tick) -> m (Tick, Tick))
-> IO (Tick, Tick) -> m (Tick, Tick)
forall a b. (a -> b) -> a -> b
$ World -> IO (Tick, Tick)
getSystemTicksInternal World
world
          return $ f ticks lastSystemTick currentSystemTick

added :: forall c m w. (MonadSystem w m, GetResultComponentId (Result c)) => Result c -> m Bool
added :: forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
Result c -> m Bool
added = (ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
(ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
qfAddedF

changed :: forall c m w. (MonadSystem w m, GetResultComponentId (Result c)) => Result c -> m Bool
changed :: forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
Result c -> m Bool
changed = (ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
(ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
qfChangedF

getSystemTicksInternal :: World -> IO (Tick, Tick)
getSystemTicksInternal :: World -> IO (Tick, Tick)
getSystemTicksInternal 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