module Mischief.ECS.Archetypes.Graph where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Primitive
import Control.Monad.Reader
import Data.Data
import Data.Foldable
import Data.IORef
import Data.List
import Data.Map (Map, mapMaybe)
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Base (eqWord#, isTrue#)
import Mischief.ECS.Archetypes
import Mischief.ECS.Components
import Mischief.ECS.Components.Common
import Mischief.ECS.Entities
import Mischief.ECS.EntityDef
import Mischief.ECS.Log
import Mischief.ECS.Relationships
import Mischief.ECS.Tables
import Mischief.ECS.Utils
import Mischief.ECS.Vec (IOVec)
import Mischief.ECS.Vec qualified as Vec
import Mischief.ECS.World
import Mischief.ECS.World (SystemTools (get))
import Mischief.ECS.World.Query.Queryable

data ArchetypeTransition = Inserted ComponentId | Removed ComponentId

getNewId :: ArchetypeGraph -> IO Int
getNewId :: ArchetypeGraph -> IO Int
getNewId ArchetypeGraph {IORef Int
counter :: IORef Int
counter :: ArchetypeGraph -> IORef Int
counter} = do
  x <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
counter
  modifyIORef' counter (+ 1)
  return x

createNode :: Set ComponentId -> System Int
createNode :: Set ComponentId -> System Int
createNode Set ComponentId
components = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let Archetypes {graph} = world.archetypes

  id <- liftIO $ getNewId graph
  liftIO $ modifyIORef' graph.lookup $ Map.insert components id
  Vec.pushBack graph.nodes ArchetypeNode {archetype = ArchetypeData {id = ArchetypeId id, components}, insert = Map.empty, remove = Map.empty}

  -- comps <-
  --   mapM
  --     ( \(ComponentId (# id, _ #)) -> do
  --         t <- worldGet (Proxy @ComponentType) (Entity (# id, 0## #))
  --         return $ fmap getRep t
  --     )
  --     (Set.toList components)

  -- debug $ "archetype " <> text id <> " = " <> text (catMaybes comps)

  let Tables tables = world.tables
  Vec.pushBack tables =<< liftIO (newTable $ Set.toList components)

  for_ components $ \(ComponentId (# Word#
id', Maybe Entity
target' #)) -> do
    case Maybe Entity
target' of
      -- Component isn't a pair.
      Maybe Entity
Nothing -> do
        set <- Proxy ComponentArchetypes
-> Entity -> System (Maybe ComponentArchetypes)
forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
worldGet (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ComponentArchetypes) ((# Word#, Word# #) -> Entity
Entity (# Word#
id', Word#
0## #))
        for_ set $ \ComponentArchetypes
set -> do
          ComponentArchetypes -> Entity -> System ()
forall c. Bundle c => c -> Entity -> System ()
worldSet (ComponentArchetypes {inner :: Set ArchetypeId
inner = ArchetypeId -> Set ArchetypeId -> Set ArchetypeId
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> ArchetypeId
ArchetypeId Int
id) ComponentArchetypes
set.inner}) ((# Word#, Word# #) -> Entity
Entity (# Word#
id', Word#
0## #))
      -- modify set $ \ComponentArchetypes {inner} -> ComponentArchetypes {inner = Set.insert (ArchetypeId id) inner}
      -- Component is a pair.
      Just Entity
e -> do
        set <- Proxy ComponentPairs -> Entity -> System (Maybe ComponentPairs)
forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
worldGet (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ComponentPairs) ((# Word#, Word# #) -> Entity
Entity (# Word#
id', Word#
0## #))
        for_ set $ \ComponentPairs
set -> do
          let ComponentPairs {Set ArchetypeId
any :: Set ArchetypeId
any :: ComponentPairs -> Set ArchetypeId
any, Map Entity (Set ArchetypeId)
pairs :: Map Entity (Set ArchetypeId)
pairs :: ComponentPairs -> Map Entity (Set ArchetypeId)
pairs} = ComponentPairs
set
          (ComponentPairs -> Entity -> System ())
-> Entity -> ComponentPairs -> System ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComponentPairs -> Entity -> System ()
forall c. Bundle c => c -> Entity -> System ()
worldSet ((# Word#, Word# #) -> Entity
Entity (# Word#
id', Word#
0## #)) (ComponentPairs -> System ()) -> ComponentPairs -> System ()
forall a b. (a -> b) -> a -> b
$
            ComponentPairs
              { any :: Set ArchetypeId
any = ArchetypeId -> Set ArchetypeId -> Set ArchetypeId
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> ArchetypeId
ArchetypeId Int
id) Set ArchetypeId
any,
                pairs :: Map Entity (Set ArchetypeId)
pairs =
                  (Maybe (Set ArchetypeId) -> Maybe (Set ArchetypeId))
-> Entity
-> Map Entity (Set ArchetypeId)
-> Map Entity (Set ArchetypeId)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
                    ( \case
                        Maybe (Set ArchetypeId)
Nothing -> Set ArchetypeId -> Maybe (Set ArchetypeId)
forall a. a -> Maybe a
Just (Set ArchetypeId -> Maybe (Set ArchetypeId))
-> Set ArchetypeId -> Maybe (Set ArchetypeId)
forall a b. (a -> b) -> a -> b
$ ArchetypeId -> Set ArchetypeId
forall a. a -> Set a
Set.singleton (ArchetypeId -> Set ArchetypeId) -> ArchetypeId -> Set ArchetypeId
forall a b. (a -> b) -> a -> b
$ Int -> ArchetypeId
ArchetypeId Int
id
                        Just Set ArchetypeId
s -> Set ArchetypeId -> Maybe (Set ArchetypeId)
forall a. a -> Maybe a
Just (Set ArchetypeId -> Maybe (Set ArchetypeId))
-> Set ArchetypeId -> Maybe (Set ArchetypeId)
forall a b. (a -> b) -> a -> b
$ ArchetypeId -> Set ArchetypeId -> Set ArchetypeId
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> ArchetypeId
ArchetypeId Int
id) Set ArchetypeId
s
                    )
                    Entity
e
                    Map Entity (Set ArchetypeId)
pairs
              }

  return id

getOrCreateNode :: Set ComponentId -> System Int
getOrCreateNode :: Set ComponentId -> System Int
getOrCreateNode Set ComponentId
components = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let Archetypes {graph} = world.archetypes

  lookup <- liftIO $ readIORef graph.lookup
  case Map.lookup components lookup of
    Just Int
x -> Int -> System Int
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
x
    Maybe Int
Nothing -> Set ComponentId -> System Int
createNode Set ComponentId
components

addEdge :: Int -> Int -> ComponentId -> System ()
addEdge :: Int -> Int -> ComponentId -> System ()
addEdge Int
a Int
b ComponentId
component = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let Archetypes {graph} = world.archetypes
  Vec.modify_ graph.nodes a $ \ArchetypeNode {Map ComponentId Int
insert :: ArchetypeNode -> Map ComponentId Int
insert :: Map ComponentId Int
insert, Map ComponentId Int
remove :: ArchetypeNode -> Map ComponentId Int
remove :: Map ComponentId Int
remove, ArchetypeData
archetype :: ArchetypeNode -> ArchetypeData
archetype :: ArchetypeData
archetype} -> ArchetypeNode {insert :: Map ComponentId Int
insert = ComponentId -> Int -> Map ComponentId Int -> Map ComponentId Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ComponentId
component Int
b Map ComponentId Int
insert, Map ComponentId Int
remove :: Map ComponentId Int
remove :: Map ComponentId Int
remove, ArchetypeData
archetype :: ArchetypeData
archetype :: ArchetypeData
archetype}
  Vec.modify_ graph.nodes b $ \ArchetypeNode {Map ComponentId Int
insert :: ArchetypeNode -> Map ComponentId Int
insert :: Map ComponentId Int
insert, Map ComponentId Int
remove :: ArchetypeNode -> Map ComponentId Int
remove :: Map ComponentId Int
remove, ArchetypeData
archetype :: ArchetypeNode -> ArchetypeData
archetype :: ArchetypeData
archetype} -> ArchetypeNode {Map ComponentId Int
insert :: Map ComponentId Int
insert :: Map ComponentId Int
insert, remove :: Map ComponentId Int
remove = ComponentId -> Int -> Map ComponentId Int -> Map ComponentId Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ComponentId
component Int
a Map ComponentId Int
remove, ArchetypeData
archetype :: ArchetypeData
archetype :: ArchetypeData
archetype}

addEdgeI :: Int -> Int -> ComponentId -> System ()
addEdgeI :: Int -> Int -> ComponentId -> System ()
addEdgeI Int
a Int
b ComponentId
component = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let Archetypes {graph} = world.archetypes
  Vec.modify_ graph.nodes a $ \ArchetypeNode {Map ComponentId Int
insert :: ArchetypeNode -> Map ComponentId Int
insert :: Map ComponentId Int
insert, Map ComponentId Int
remove :: ArchetypeNode -> Map ComponentId Int
remove :: Map ComponentId Int
remove, ArchetypeData
archetype :: ArchetypeNode -> ArchetypeData
archetype :: ArchetypeData
archetype} -> ArchetypeNode {insert :: Map ComponentId Int
insert = ComponentId -> Int -> Map ComponentId Int -> Map ComponentId Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ComponentId
component Int
b Map ComponentId Int
insert, Map ComponentId Int
remove :: Map ComponentId Int
remove :: Map ComponentId Int
remove, ArchetypeData
archetype :: ArchetypeData
archetype :: ArchetypeData
archetype}

addEdgeR :: Int -> Int -> ComponentId -> System ()
addEdgeR :: Int -> Int -> ComponentId -> System ()
addEdgeR Int
a Int
b ComponentId
component = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let Archetypes {graph} = world.archetypes
  Vec.modify_ graph.nodes b $ \ArchetypeNode {Map ComponentId Int
insert :: ArchetypeNode -> Map ComponentId Int
insert :: Map ComponentId Int
insert, Map ComponentId Int
remove :: ArchetypeNode -> Map ComponentId Int
remove :: Map ComponentId Int
remove, ArchetypeData
archetype :: ArchetypeNode -> ArchetypeData
archetype :: ArchetypeData
archetype} -> ArchetypeNode {Map ComponentId Int
insert :: Map ComponentId Int
insert :: Map ComponentId Int
insert, remove :: Map ComponentId Int
remove = ComponentId -> Int -> Map ComponentId Int -> Map ComponentId Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ComponentId
component Int
a Map ComponentId Int
remove, ArchetypeData
archetype :: ArchetypeData
archetype :: ArchetypeData
archetype}

getArchetypeOnRemoveSingle :: ArchetypeId -> ComponentId -> System ArchetypeData
getArchetypeOnRemoveSingle :: ArchetypeId -> ComponentId -> System ArchetypeData
getArchetypeOnRemoveSingle (ArchetypeId Int
id) ComponentId
component = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let Archetypes {graph} = world.archetypes

  node <- Vec.read graph.nodes id

  case Map.lookup component node.remove of
    Just Int
x -> do
      newNode <- Vec (PrimState System) ArchetypeNode -> Int -> System ArchetypeNode
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m) =>
Vec (PrimState m) a -> Int -> m a
Vec.read ArchetypeGraph
graph.nodes Int
x
      return newNode.archetype
    Maybe Int
Nothing -> do
      let components :: Set ComponentId
components = ArchetypeNode
node.archetype.components
      -- TODO: check if another component requires this one!

      let newComponents :: Set ComponentId
newComponents = ComponentId -> Set ComponentId -> Set ComponentId
forall a. Ord a => a -> Set a -> Set a
Set.delete ComponentId
component Set ComponentId
components
      newId <- Set ComponentId -> System Int
getOrCreateNode Set ComponentId
newComponents
      addEdgeR newId id component

      newNode <- Vec.read graph.nodes newId
      return newNode.archetype

getArchetypeOnInsertSingle :: ArchetypeId -> ComponentId -> System ArchetypeData
getArchetypeOnInsertSingle :: ArchetypeId -> ComponentId -> System ArchetypeData
getArchetypeOnInsertSingle (ArchetypeId Int
id) ComponentId
component = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let Archetypes {graph} = world.archetypes

  node <- Vec.read graph.nodes id

  case Map.lookup component node.insert of
    Just Int
x -> do
      newNode <- Vec (PrimState System) ArchetypeNode -> Int -> System ArchetypeNode
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m) =>
Vec (PrimState m) a -> Int -> m a
Vec.read ArchetypeGraph
graph.nodes Int
x
      return newNode.archetype
    Maybe Int
Nothing -> do
      components <- do
        let components :: Set ComponentId
components = ArchetypeNode
node.archetype.components

        let !(ComponentId (# Word#
id, Maybe Entity
_ #)) = ComponentId
component

        isExclusiveRel <- Maybe IsExclusiveRelationship -> Bool
forall a. Maybe a -> Bool
isJust (Maybe IsExclusiveRelationship -> Bool)
-> System (Maybe IsExclusiveRelationship) -> System Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy IsExclusiveRelationship
-> Entity -> System (Maybe IsExclusiveRelationship)
forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
worldGet (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @IsExclusiveRelationship) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))

        case isExclusiveRel of
          Bool
True ->
            Set ComponentId -> System (Set ComponentId)
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ComponentId -> System (Set ComponentId))
-> Set ComponentId -> System (Set ComponentId)
forall a b. (a -> b) -> a -> b
$ (ComponentId -> Bool) -> Set ComponentId -> Set ComponentId
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\(ComponentId (# Word#
id', Maybe Entity
a #)) -> Bool -> Bool
not (Int# -> Bool
isTrue# (Int# -> Bool) -> Int# -> Bool
forall a b. (a -> b) -> a -> b
$ Word# -> Word# -> Int#
eqWord# Word#
id' Word#
id) Bool -> Bool -> Bool
|| Maybe Entity -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Entity
a) Set ComponentId
components
          Bool
_ ->
            Set ComponentId -> System (Set ComponentId)
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return Set ComponentId
components

      requirements <- getRequirements component

      let newComponents = Set ComponentId -> Set ComponentId -> Set ComponentId
forall a. Ord a => Set a -> Set a -> Set a
Set.union (ComponentId -> Set ComponentId -> Set ComponentId
forall a. Ord a => a -> Set a -> Set a
Set.insert ComponentId
component Set ComponentId
components) Set ComponentId
requirements

      newId <- getOrCreateNode newComponents
      addEdgeI id newId component

      newNode <- Vec.read graph.nodes newId
      return newNode.archetype

getArchetypeOnInsert :: ArchetypeId -> [ComponentId] -> System ArchetypeData
getArchetypeOnInsert :: ArchetypeId -> [ComponentId] -> System ArchetypeData
getArchetypeOnInsert ArchetypeId
archetype [ComponentId]
components =
  do
    world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
    let Archetypes {graph} = world.archetypes
    let d = ArchetypeData {id :: ArchetypeId
id = ArchetypeId
archetype, components :: Set ComponentId
components = Set ComponentId
forall a. Set a
Set.empty}

    f d components graph
  where
    f :: ArchetypeData -> [ComponentId] -> t -> System ArchetypeData
f ArchetypeData
archetype [] t
_ = ArchetypeData -> System ArchetypeData
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return ArchetypeData
archetype
    f ArchetypeData
archetype (ComponentId
component : [ComponentId]
xs) t
graph = do
      x <- ArchetypeId -> ComponentId -> System ArchetypeData
getArchetypeOnInsertSingle ArchetypeData
archetype.id ComponentId
component
      f x xs graph

newtype ArchetypeRemovalResult = ArchetypeRemovalResult {ArchetypeRemovalResult -> [ComponentId]
removed :: [ComponentId]}

getArchetypeOnRemove :: ArchetypeId -> [ComponentId] -> System (ArchetypeData, [ComponentId])
getArchetypeOnRemove :: ArchetypeId
-> [ComponentId] -> System (ArchetypeData, [ComponentId])
getArchetypeOnRemove ArchetypeId
archetype [ComponentId]
components =
  do
    world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
    let Archetypes {graph} = world.archetypes
    let d = ArchetypeData {id :: ArchetypeId
id = ArchetypeId
archetype, components :: Set ComponentId
components = Set ComponentId
forall a. Set a
Set.empty}

    f d components graph
  where
    f :: ArchetypeData
-> [ComponentId] -> t -> System (ArchetypeData, [ComponentId])
f ArchetypeData
archetype [] t
_ = (ArchetypeData, [ComponentId])
-> System (ArchetypeData, [ComponentId])
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArchetypeData
archetype, [])
    f ArchetypeData
archetype (ComponentId
component : [ComponentId]
xs) t
graph = do
      x <- ArchetypeId -> ComponentId -> System ArchetypeData
getArchetypeOnRemoveSingle ArchetypeData
archetype.id ComponentId
component

      (a, b) <- f x xs graph
      if x.id /= archetype.id
        then return (a, b ++ [component])
        else return (a, b)

getArchetypeOnSpawn :: [ComponentId] -> System ArchetypeData
getArchetypeOnSpawn :: [ComponentId] -> System ArchetypeData
getArchetypeOnSpawn [ComponentId]
components =
  do
    world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
    let Archetypes {graph} = world.archetypes

    regs <- mapM getRequirements components

    let allComps = (Set ComponentId -> Set ComponentId -> Set ComponentId)
-> Set ComponentId -> [Set ComponentId] -> Set ComponentId
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' ((Set ComponentId -> Set ComponentId -> Set ComponentId)
-> Set ComponentId -> Set ComponentId -> Set ComponentId
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set ComponentId -> Set ComponentId -> Set ComponentId
forall a. Ord a => Set a -> Set a -> Set a
Set.union) ([ComponentId] -> Set ComponentId
forall a. Ord a => [a] -> Set a
Set.fromList [ComponentId]
components) [Set ComponentId]
regs
    node <- getOrCreateNode allComps

    nodeData <- Vec.read graph.nodes node

    return nodeData.archetype

getRequirements :: ComponentId -> System (Set ComponentId)
getRequirements :: ComponentId -> System (Set ComponentId)
getRequirements (ComponentId (# Word#
id, Maybe Entity
_ #)) = do
  x <- Proxy Requires -> Entity -> System (Maybe [Rel Requires])
forall c (m :: * -> *) w.
(Component c, MonadSystem w m, RelExclusivity c ~ 'Inclusive) =>
Proxy c -> Entity -> m (Maybe [Rel c])
worldGetRAny (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Requires) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
  return $ case x of
    Maybe [Rel Requires]
Nothing -> Set ComponentId
forall a. Set a
Set.empty
    Just [Rel Requires]
x -> [ComponentId] -> Set ComponentId
forall a. Ord a => [a] -> Set a
Set.fromList ([ComponentId] -> Set ComponentId)
-> [ComponentId] -> Set ComponentId
forall a b. (a -> b) -> a -> b
$ (Rel Requires -> ComponentId) -> [Rel Requires] -> [ComponentId]
forall a b. (a -> b) -> [a] -> [b]
map ((\(Entity (# Word#
id, Word#
_ #)) -> (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
id, Maybe Entity
forall a. Maybe a
Nothing #)) (Entity -> ComponentId)
-> (Rel Requires -> Entity) -> Rel Requires -> ComponentId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Rel Requires
x -> Rel Requires
x.target)) [Rel Requires]
x

data ComponentQuery = ComponentQuery | RelationshipQueryAny | RelationshipQuery

findMatchingArchetypes :: forall m w. (MonadSystem w m) => [(ComponentId, ComponentQuery)] -> Archetypes -> m [([ComponentId], ArchetypeId)]
findMatchingArchetypes :: forall (m :: * -> *) w.
MonadSystem w m =>
[(ComponentId, ComponentQuery)]
-> Archetypes -> m [([ComponentId], ArchetypeId)]
findMatchingArchetypes [] Archetypes
_ = m [([ComponentId], ArchetypeId)]
forall (m :: * -> *) w.
MonadSystem w m =>
m [([ComponentId], ArchetypeId)]
allArchetypes
findMatchingArchetypes [(ComponentId, ComponentQuery)]
components Archetypes {ArchetypeGraph
graph :: Archetypes -> ArchetypeGraph
graph :: ArchetypeGraph
graph} = do
  archetypes'' <- [(ComponentId, ComponentQuery)]
-> ((ComponentId, ComponentQuery) -> m (Set ArchetypeId))
-> m [Set ArchetypeId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ComponentId, ComponentQuery)]
components (((ComponentId, ComponentQuery) -> m (Set ArchetypeId))
 -> m [Set ArchetypeId])
-> ((ComponentId, ComponentQuery) -> m (Set ArchetypeId))
-> m [Set ArchetypeId]
forall a b. (a -> b) -> a -> b
$ \(ComponentId (# Word#
id, Maybe Entity
target #), ComponentQuery
q) -> do
    case ComponentQuery
q of
      ComponentQuery
ComponentQuery -> do
        Just x <- Proxy ComponentArchetypes
-> Entity -> m (Maybe ComponentArchetypes)
forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
worldGet (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ComponentArchetypes) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
        return x.inner
      ComponentQuery
RelationshipQueryAny -> do
        Just x <- Proxy ComponentPairs -> Entity -> m (Maybe ComponentPairs)
forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
worldGet (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ComponentPairs) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
        return x.any
      ComponentQuery
RelationshipQuery -> do
        case Maybe Entity
target of
          Maybe Entity
Nothing -> m (Set ArchetypeId)
forall a. HasCallStack => a
undefined
          Just Entity
target -> do
            Just x <- Proxy ComponentPairs -> Entity -> m (Maybe ComponentPairs)
forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
worldGet (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ComponentPairs) ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
            return $ fromMaybe undefined $ Map.lookup target x.pairs

  case map Set.toList archetypes'' of
    [] -> [([ComponentId], ArchetypeId)] -> m [([ComponentId], ArchetypeId)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [ArchetypeId]
h : [[ArchetypeId]]
tail -> do
      let archetypes :: [ArchetypeId]
archetypes = ([ArchetypeId] -> [ArchetypeId] -> [ArchetypeId])
-> [ArchetypeId] -> [[ArchetypeId]] -> [ArchetypeId]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [ArchetypeId] -> [ArchetypeId] -> [ArchetypeId]
forall a. Eq a => [a] -> [a] -> [a]
intersect [ArchetypeId]
h [[ArchetypeId]]
tail

      (ArchetypeId -> m ([ComponentId], ArchetypeId))
-> [ArchetypeId] -> m [([ComponentId], ArchetypeId)]
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
        ( \(ArchetypeId Int
x) -> do
            x' <- Vec (PrimState m) ArchetypeNode -> Int -> m ArchetypeNode
forall (m :: * -> *) a.
(HasCallStack, PrimMonad m) =>
Vec (PrimState m) a -> Int -> m a
Vec.read ArchetypeGraph
graph.nodes Int
x
            return (Set.toList x'.archetype.components, ArchetypeId x)
        )
        [ArchetypeId]
archetypes

allArchetypes :: forall m w. (MonadSystem w m) => m [([ComponentId], ArchetypeId)]
allArchetypes :: forall (m :: * -> *) w.
MonadSystem w m =>
m [([ComponentId], ArchetypeId)]
allArchetypes = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  map (\ArchetypeNode
x -> (Set ComponentId -> [ComponentId]
forall a. Set a -> [a]
Set.toList ArchetypeNode
x.archetype.components, ArchetypeNode
x.archetype.id)) <$> Vec.toList world.archetypes.graph.nodes