module Mischief.ECS.Archetypes.Graph where

import Control.Monad
import Control.Monad.IO.Class
import Data.Data
import Data.Foldable
import Data.IORef
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.Entities
import Mischief.ECS.Tables
import Mischief.ECS.Vec qualified as Vec
import Mischief.ECS.World

data ArchetypeTransition = Inserted ComponentId | Removed ComponentId

getNewId :: ArchetypeGraph -> IO Int
getNewId :: ArchetypeGraph -> IO Int
getNewId ArchetypeGraph {counter :: ArchetypeGraph -> IORef Int
counter = !IORef Int
counter} = do
  !x <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
counter
  modifyIORef' counter (+ 1)
  pure 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 = !graph} = world.archetypes

  !id <- liftIO $ getNewId graph
  liftIO $ modifyIORef' graph.lookup $ Map.insert components id
  liftIO $ modifyIORef' graph.allArchetypes $ Set.insert (ArchetypeId 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 " <> T.show id <> " = " <> T.show (catMaybes comps) <> " (length = " <> T.show (length $ Set.toList components) <> ")"
  -- debug $ T.show $ Set.toList components

  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, Component 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## #))

        when (isNothing set) $ do
          worldSet (ComponentArchetypes {inner = Set.singleton (ArchetypeId id)}) (Entity (# id', 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, Component 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
              }

  pure 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 = !graph} = world.archetypes

  !lookup <- liftIO $ readIORef graph.lookup
  -- warn $ T.show lookup
  case Map.lookup components lookup of
    Just !Int
x -> Int -> System Int
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = !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 = !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 = !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 = !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
      pure 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 = !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
      pure 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, Component 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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 (f :: * -> *) a. Applicative f => a -> f a
pure 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
      pure 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 = !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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 = !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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 pure (a, b ++ [component])
        else pure (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 = !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

    pure 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, IsExclusiveRel c ~ 'False) =>
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## #))
  pure $ 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)] -> m (Set ArchetypeId)
findMatchingArchetypes :: forall (m :: * -> *) w.
MonadSystem w m =>
[(ComponentId, ComponentQuery)] -> m (Set ArchetypeId)
findMatchingArchetypes [] = m (Set ArchetypeId)
forall (m :: * -> *) w. MonadSystem w m => m (Set ArchetypeId)
allArchetypes
findMatchingArchetypes [(ComponentId, ComponentQuery)]
components = 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
        !x <- ComponentArchetypes
-> Maybe ComponentArchetypes -> ComponentArchetypes
forall a. a -> Maybe a -> a
fromMaybe (Set ArchetypeId -> ComponentArchetypes
ComponentArchetypes Set ArchetypeId
forall a. Set a
Set.empty) (Maybe ComponentArchetypes -> ComponentArchetypes)
-> m (Maybe ComponentArchetypes) -> m ComponentArchetypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ComponentArchetypes
-> Entity -> m (Maybe ComponentArchetypes)
forall c (m :: * -> *) w.
(MonadSystem w m, Component 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## #))
        pure x.inner
      ComponentQuery
RelationshipQueryAny -> do
        Just !x <- Proxy ComponentPairs -> Entity -> m (Maybe ComponentPairs)
forall c (m :: * -> *) w.
(MonadSystem w m, Component 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## #))
        pure 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, Component 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## #))
            pure $ fromMaybe Set.empty $ Map.lookup target x.pairs

  -- TODO: use Set.intersections from containers >=0.8
  pure $ case archetypes'' of
    [] -> Set ArchetypeId
forall a. Set a
Set.empty
    !Set ArchetypeId
h : ![Set ArchetypeId]
t -> (Set ArchetypeId -> Set ArchetypeId -> Set ArchetypeId)
-> Set ArchetypeId -> [Set ArchetypeId] -> Set ArchetypeId
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set ArchetypeId -> Set ArchetypeId -> Set ArchetypeId
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set ArchetypeId
h [Set ArchetypeId]
t

allArchetypes :: forall m w. (MonadSystem w m) => m (Set ArchetypeId)
allArchetypes :: forall (m :: * -> *) w. MonadSystem w m => m (Set ArchetypeId)
allArchetypes = do
  !world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  liftIO $ readIORef world.archetypes.graph.allArchetypes

archetypesWith :: forall m w. (MonadSystem w m) => (ComponentId, ComponentQuery) -> m (Set ArchetypeId)
archetypesWith :: forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentId, ComponentQuery) -> m (Set ArchetypeId)
archetypesWith (ComponentId (# Word#
id, Maybe Entity
_ #), ComponentQuery
ComponentQuery) = do
  !x <- ComponentArchetypes
-> Maybe ComponentArchetypes -> ComponentArchetypes
forall a. a -> Maybe a -> a
fromMaybe (Set ArchetypeId -> ComponentArchetypes
ComponentArchetypes Set ArchetypeId
forall a. Set a
Set.empty) (Maybe ComponentArchetypes -> ComponentArchetypes)
-> m (Maybe ComponentArchetypes) -> m ComponentArchetypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ComponentArchetypes
-> Entity -> m (Maybe ComponentArchetypes)
forall c (m :: * -> *) w.
(MonadSystem w m, Component 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## #))
  pure x.inner
archetypesWith (ComponentId (# Word#
id, Maybe Entity
_ #), ComponentQuery
RelationshipQueryAny) = do
  Just !x <- Proxy ComponentPairs -> Entity -> m (Maybe ComponentPairs)
forall c (m :: * -> *) w.
(MonadSystem w m, Component 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## #))
  pure x.any
archetypesWith (ComponentId (# Word#
id, Maybe Entity
target #), 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, Component 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## #))
      pure $ fromMaybe Set.empty $ Map.lookup target x.pairs

archetypesWithout :: forall m w. (MonadSystem w m) => (ComponentId, ComponentQuery) -> m (Set ArchetypeId)
archetypesWithout :: forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentId, ComponentQuery) -> m (Set ArchetypeId)
archetypesWithout (ComponentId, ComponentQuery)
x = do
  x <- (ComponentId, ComponentQuery) -> m (Set ArchetypeId)
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentId, ComponentQuery) -> m (Set ArchetypeId)
archetypesWith (ComponentId, ComponentQuery)
x
  a <- allArchetypes
  pure $ Set.difference a x