{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.Tables where

import Control.Monad (forM, when)
import Data.Bifunctor qualified
import Data.Foldable (Foldable (toList), for_)
import Data.IORef
import Data.List (transpose)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes)
import Data.Traversable (for)
import Data.Vector qualified as Vector
import GHC.Base (Int (..), eqWord#, isTrue#)
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Entities
import Mischief.ECS.Vec (IOVec)
import Mischief.ECS.Vec qualified as Vec

newtype Tables = Tables {Tables -> IOVec Table
inner :: IOVec Table}

data Table = Table
  { Table -> IORef (Map ComponentId Column)
columns :: IORef (Map ComponentId Column),
    Table -> [ComponentId]
components :: [ComponentId],
    Table -> IORef (Map ComponentId ComponentTick)
ticks :: IORef (Map ComponentId ComponentTick),
    Table -> Vec RealWorld (Entity, IORef EntityPointer)
entities :: IOVec (Entity, IORef EntityPointer)
  }

newtype Column = Column (IOVec ErasedComponent)

baseline_entities_cap :: Int
baseline_entities_cap :: Int
baseline_entities_cap = Int
64

emptyTables :: IO Tables
emptyTables :: IO Tables
emptyTables = do
  v <- Int -> IO (Vec (PrimState IO) Table)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (Vec (PrimState m) a)
Vec.new Int
128
  Vec.pushBack v =<< newTable []
  pure $ Tables v

newTable :: [ComponentId] -> IO Table
newTable :: [ComponentId] -> IO Table
newTable [ComponentId]
components = do
  cols <-
    [ComponentId]
-> (ComponentId -> IO (ComponentId, Column))
-> IO [(ComponentId, Column)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ComponentId]
components ((ComponentId -> IO (ComponentId, Column))
 -> IO [(ComponentId, Column)])
-> (ComponentId -> IO (ComponentId, Column))
-> IO [(ComponentId, Column)]
forall a b. (a -> b) -> a -> b
$ \ComponentId
x -> do
      empty_vec <- Int -> IO (Vec (PrimState IO) ErasedComponent)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (Vec (PrimState m) a)
Vec.new Int
baseline_entities_cap
      pure (x, Column empty_vec)

  columns <- newIORef $ Map.fromList (toList cols)
  entities <- Vec.new baseline_entities_cap
  ticks <- newIORef $ Map.fromList (map (,ComponentTick (Tick 0)) components)

  return $ Table {columns = columns, components, entities, ticks}

tableIsEmpty :: Table -> IO Bool
tableIsEmpty :: Table -> IO Bool
tableIsEmpty Table
table = Vec (PrimState IO) (Entity, IORef EntityPointer) -> IO Bool
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> m Bool
Vec.null Table
table.entities

-- removeTable :: ArchetypeId -> Tables -> IO ()
-- removeTable archetype tables = do
--   let Tables tables' = tables
--   modifyIORef' tables' $ Map.filterWithKey (\archetype' _ -> archetype' /= archetype)

-- |
--  runs the specified monadic action with the value of the given map key as input, if the key exists.
--  if it doesn't, do nothing
tapMap ::
  (Monad m, Ord k) =>
  Map k a ->
  k ->
  (a -> m ()) ->
  m ()
tapMap :: forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k a -> k -> (a -> m ()) -> m ()
tapMap Map k a
map k
k a -> m ()
act = do
  m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> m ()
act (Maybe a -> m ()) -> Maybe a -> m ()
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k a
map

insertComponentsIntoMap :: ProcessedBundleData -> Map ComponentId Column -> IO ()
insertComponentsIntoMap :: ProcessedBundleData -> Map ComponentId Column -> IO ()
insertComponentsIntoMap ProcessedBundleData
bundle Map ComponentId Column
map =
  [ProcessedBundleElement]
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ProcessedBundleData
bundle.elements ((ProcessedBundleElement -> IO ()) -> IO ())
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ProcessedBundleElement
el ->
    Map ComponentId Column -> ComponentId -> (Column -> IO ()) -> IO ()
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k a -> k -> (a -> m ()) -> m ()
tapMap Map ComponentId Column
map ProcessedBundleElement
el.id ((Column -> IO ()) -> IO ()) -> (Column -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Column IOVec ErasedComponent
col) ->
      Vec (PrimState IO) ErasedComponent -> ErasedComponent -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> a -> m ()
Vec.pushBack IOVec ErasedComponent
Vec (PrimState IO) ErasedComponent
col ProcessedBundleElement
el.component

insertComponentsIntoTable :: ProcessedBundleData -> Tick -> ChangedComponents -> Table -> IO ()
insertComponentsIntoTable :: ProcessedBundleData -> Tick -> [ComponentId] -> Table -> IO ()
insertComponentsIntoTable ProcessedBundleData
bundle Tick
tick [ComponentId]
changed Table
table = do
  [ComponentId] -> (ComponentId -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ComponentId]
changed ((ComponentId -> IO ()) -> IO ())
-> (ComponentId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ComponentId
a -> IORef (Map ComponentId ComponentTick)
-> (Map ComponentId ComponentTick -> Map ComponentId ComponentTick)
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' Table
table.ticks (ComponentId
-> ComponentTick
-> Map ComponentId ComponentTick
-> Map ComponentId ComponentTick
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ComponentId
a (Tick -> ComponentTick
ComponentTick Tick
tick))

  cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
  insertComponentsIntoMap bundle cols

replaceComponentsIntoMap ::
  ProcessedBundleData ->
  EntityPointer ->
  Map ComponentId Column ->
  IO ()
replaceComponentsIntoMap :: ProcessedBundleData
-> EntityPointer -> Map ComponentId Column -> IO ()
replaceComponentsIntoMap ProcessedBundleData
bundle (EntityPointer (# Int#
_, Int#
rowIndex #)) Map ComponentId Column
tableMap = do
  [ProcessedBundleElement]
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ProcessedBundleData
bundle.elements ((ProcessedBundleElement -> IO ()) -> IO ())
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ProcessedBundleElement
el ->
    Map ComponentId Column -> ComponentId -> (Column -> IO ()) -> IO ()
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k a -> k -> (a -> m ()) -> m ()
tapMap Map ComponentId Column
tableMap ProcessedBundleElement
el.id ((Column -> IO ()) -> IO ()) -> (Column -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Column IOVec ErasedComponent
col) ->
      Vec (PrimState IO) ErasedComponent
-> Int -> ErasedComponent -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> a -> m ()
Vec.unsafeWrite IOVec ErasedComponent
Vec (PrimState IO) ErasedComponent
col (Int# -> Int
I# Int#
rowIndex) ProcessedBundleElement
el.component

--   foldl' modifyMap tableMap bundle.elements
--  where
--   modifyMap tableMap element = Map.adjust (modifyComponents element) element.id tableMap
--   modifyComponents element (Column x) =
--     let (x', _ : ys) = splitAt pointer.rowIndex x
--      in Column $ x' ++ [element.component] ++ ys

replaceComponentsIntoTable ::
  ProcessedBundleData ->
  -- | The current tick that will be as the components' change tick.
  Maybe Tick ->
  EntityPointer ->
  Table ->
  IO ()
replaceComponentsIntoTable :: ProcessedBundleData
-> Maybe Tick -> EntityPointer -> Table -> IO ()
replaceComponentsIntoTable ProcessedBundleData
bundle Maybe Tick
tick EntityPointer
pointer Table
table = do
  case Maybe Tick
tick of
    Maybe Tick
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Tick
tick -> do
      [ProcessedBundleElement]
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ProcessedBundleData
bundle.elements ((ProcessedBundleElement -> IO ()) -> IO ())
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ProcessedBundleElement
a -> IORef (Map ComponentId ComponentTick)
-> (Map ComponentId ComponentTick -> Map ComponentId ComponentTick)
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' Table
table.ticks (ComponentId
-> ComponentTick
-> Map ComponentId ComponentTick
-> Map ComponentId ComponentTick
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ProcessedBundleElement
a.id (Tick -> ComponentTick
ComponentTick Tick
tick))

  cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
  replaceComponentsIntoMap bundle pointer cols

takeFromColumn :: EntityPointer -> Column -> IO ErasedComponent
takeFromColumn :: EntityPointer -> Column -> IO ErasedComponent
takeFromColumn (EntityPointer (# Int#
_, Int#
rowIndex #)) (Column IOVec ErasedComponent
col) = Vec (PrimState IO) ErasedComponent -> Int -> IO ErasedComponent
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.takeSwap IOVec ErasedComponent
Vec (PrimState IO) ErasedComponent
col (Int# -> Int
I# Int#
rowIndex)

takeComponentsFromTable :: EntityPointer -> Table -> IO ProcessedBundleData
takeComponentsFromTable :: EntityPointer -> Table -> IO ProcessedBundleData
takeComponentsFromTable (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) Table
table = do
  cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
  newColumns <- for cols $ takeFromColumn (EntityPointer (# archetypeId, rowIndex #))
  removeEntityFromTable (I# rowIndex) table
  let elements = ((ComponentId, ErasedComponent) -> ProcessedBundleElement)
-> [(ComponentId, ErasedComponent)] -> [ProcessedBundleElement]
forall a b. (a -> b) -> [a] -> [b]
map ((ComponentId -> ErasedComponent -> ProcessedBundleElement)
-> (ComponentId, ErasedComponent) -> ProcessedBundleElement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ComponentId -> ErasedComponent -> ProcessedBundleElement
ProcessedBundleElement) ([(ComponentId, ErasedComponent)] -> [ProcessedBundleElement])
-> [(ComponentId, ErasedComponent)] -> [ProcessedBundleElement]
forall a b. (a -> b) -> a -> b
$ Map ComponentId ErasedComponent -> [(ComponentId, ErasedComponent)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ComponentId ErasedComponent
newColumns
  pure ProcessedBundleData {elements}

collectComponentIdsFromTable :: Table -> IO [ComponentId]
collectComponentIdsFromTable :: Table -> IO [ComponentId]
collectComponentIdsFromTable Table
table = do
  cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
  return $ map fst $ Map.toList cols

-- let elements = map getComponent newColumns
-- return ProcessedBundleData{elements}

removeComponentFromColumn :: EntityPointer -> Column -> IO ()
removeComponentFromColumn :: EntityPointer -> Column -> IO ()
removeComponentFromColumn (EntityPointer (# Int#
_, Int#
rowIndex #)) (Column IOVec ErasedComponent
col) = Vec (PrimState IO) ErasedComponent -> Int -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m ()
Vec.removeSwap IOVec ErasedComponent
Vec (PrimState IO) ErasedComponent
col (Int# -> Int
I# Int#
rowIndex)

removeComponentsFromMap :: EntityPointer -> Map ComponentId Column -> IO ()
removeComponentsFromMap :: EntityPointer -> Map ComponentId Column -> IO ()
removeComponentsFromMap EntityPointer
pointer Map ComponentId Column
columnMap =
  Map ComponentId Column -> (Column -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Map ComponentId Column
columnMap ((Column -> IO ()) -> IO ()) -> (Column -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ EntityPointer -> Column -> IO ()
removeComponentFromColumn EntityPointer
pointer

-- map (\(id, column) -> (id, removeComponentFromColumn pointer column)) (Map.toList columnMap)

removeComponentsFromTable :: EntityPointer -> Table -> IO ()
removeComponentsFromTable :: EntityPointer -> Table -> IO ()
removeComponentsFromTable (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) Table
table = do
  cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
  removeComponentsFromMap (EntityPointer (# archetypeId, rowIndex #)) cols
  removeEntityFromTable (I# rowIndex) table

removeRow :: Int -> IOVec (Entity, IORef EntityPointer) -> IO ()
removeRow :: Int -> Vec RealWorld (Entity, IORef EntityPointer) -> IO ()
removeRow Int
row_idx Vec RealWorld (Entity, IORef EntityPointer)
vec = do
  len <- Vec (PrimState IO) (Entity, IORef EntityPointer) -> IO Int
forall (m :: * -> *) a. PrimMonad m => Vec (PrimState m) a -> m Int
Vec.length Vec RealWorld (Entity, IORef EntityPointer)
Vec (PrimState IO) (Entity, IORef EntityPointer)
vec
  Vec.removeSwap vec row_idx
  when (row_idx < len - 1) $ do
    Vec.tap vec row_idx $ \(Entity
_, IORef EntityPointer
ptr) ->
      IORef EntityPointer -> (EntityPointer -> EntityPointer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef EntityPointer
ptr ((EntityPointer -> EntityPointer) -> IO ())
-> (EntityPointer -> EntityPointer) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(EntityPointer (# Int#
archetypeId, Int#
_ #)) ->
        let !(I# Int#
id) = Int
row_idx
         in (# Int#, Int# #) -> EntityPointer
EntityPointer (# Int#
archetypeId, Int#
id #)

removeEntityFromTable :: Int -> Table -> IO ()
removeEntityFromTable :: Int -> Table -> IO ()
removeEntityFromTable Int
row Table
table = Int -> Vec RealWorld (Entity, IORef EntityPointer) -> IO ()
removeRow Int
row Table
table.entities

-- insertResourceIntoTables :: ProcessedBundleData -> Tick -> Tables -> ArchetypeId -> (Entity, IORef EntityPointer) -> IO ()
-- insertResourceIntoTables bundle tick (Tables tables) archetype (entity, pointerRef) =
--   do
--     innerTables <- readIORef tables

--     table <- newTable bundle
--     let newTables = Map.insert archetype table innerTables
--     writeIORef tables newTables

--     rowIndex <- Vec.length table.entities
--     Vec.pushBack table.entities (entity, pointerRef)

--     let !(I# archetype') = archetype.id
--     let !(I# rowIndex') = rowIndex
--     writeIORef pointerRef $ EntityPointer (# archetype', rowIndex' #)

--     insertComponentsIntoTable bundle table

type ChangedComponents = [ComponentId]

type AddedComponents = [ComponentId]

insertEntityIntoTables :: ProcessedBundleData -> Tick -> ChangedComponents -> Tables -> ArchetypeId -> (Entity, IORef EntityPointer) -> IO ()
insertEntityIntoTables :: ProcessedBundleData
-> Tick
-> [ComponentId]
-> Tables
-> ArchetypeId
-> (Entity, IORef EntityPointer)
-> IO ()
insertEntityIntoTables ProcessedBundleData
bundle Tick
tick [ComponentId]
changed (Tables IOVec Table
tables) ArchetypeId
archetype (Entity, IORef EntityPointer)
pointerRef =
  do
    table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id

    rowIndex <- Vec.length table.entities
    Vec.pushBack table.entities pointerRef

    let !(I# archetype') = archetype.id
    let !(I# rowIndex') = rowIndex
    writeIORef (snd pointerRef) $ EntityPointer (# archetype', rowIndex' #)

    insertComponentsIntoTable bundle tick changed table

tryGetComponentFromColumn :: forall c. (Component c) => Column -> EntityPointer -> IO (Maybe c)
tryGetComponentFromColumn :: forall c. Component c => Column -> EntityPointer -> IO (Maybe c)
tryGetComponentFromColumn (Column IOVec ErasedComponent
components) (EntityPointer (# Int#
_, Int#
rowIndex #)) = do
  element <- Vec (PrimState IO) ErasedComponent -> Int -> IO ErasedComponent
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec ErasedComponent
Vec (PrimState IO) ErasedComponent
components (Int# -> Int
I# Int#
rowIndex)
  pure $ tryGetComponent element

tryGetRelCollectionFromTable :: forall c. (Component c) => Table -> Entity -> EntityPointer -> ComponentId -> IO (Maybe [(Entity, Rel c)])
tryGetRelCollectionFromTable :: forall c.
Component c =>
Table
-> Entity
-> EntityPointer
-> ComponentId
-> IO (Maybe [(Entity, Rel c)])
tryGetRelCollectionFromTable Table
table Entity
entity EntityPointer
pointer (ComponentId (# Word#
id, Maybe Entity
_ #)) =
  do
    columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
    -- TODO: improve lookup performance for partial tuples

    components' <- forM (Map.toList columns) $ \(ComponentId (# Word#
id', Maybe Entity
target' #), Column
column) -> do
      if Int# -> Bool
isTrue# (Int# -> Bool) -> Int# -> Bool
forall a b. (a -> b) -> a -> b
$ Word# -> Word# -> Int#
eqWord# Word#
id Word#
id'
        then do
          case Maybe Entity
target' of
            Maybe Entity
Nothing -> Maybe (c, Entity) -> IO (Maybe (c, Entity))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (c, Entity)
forall a. Maybe a
Nothing
            Just Entity
entity -> do
              component <- forall c. Component c => Column -> EntityPointer -> IO (Maybe c)
tryGetComponentFromColumn @c Column
column EntityPointer
pointer
              return $ fmap (,entity) component
        else Maybe (c, Entity) -> IO (Maybe (c, Entity))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (c, Entity)
forall a. Maybe a
Nothing

    if null $ catMaybes components'
      then
        return Nothing
      else do
        return $ Just $ map (\(c
value, Entity
target) -> (Entity
entity, c -> Entity -> Rel c
forall c. c -> Entity -> Rel c
Rel c
value Entity
target)) $ catMaybes components'

tryGetComponentFromTable :: forall c. (Component c) => Table -> EntityPointer -> ComponentId -> IO (Maybe c)
tryGetComponentFromTable :: forall c.
Component c =>
Table -> EntityPointer -> ComponentId -> IO (Maybe c)
tryGetComponentFromTable Table
table EntityPointer
pointer ComponentId
componentId =
  do
    columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
    let column = ComponentId -> Map ComponentId Column -> Maybe Column
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ComponentId
componentId Map ComponentId Column
columns
    case column of
      Maybe Column
Nothing -> Maybe c -> IO (Maybe c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing
      Just Column
column -> Column -> EntityPointer -> IO (Maybe c)
forall c. Component c => Column -> EntityPointer -> IO (Maybe c)
tryGetComponentFromColumn Column
column EntityPointer
pointer

tryGetRelCollectionFromTables :: forall c. (Component c) => Tables -> Entity -> EntityPointer -> ComponentId -> IO (Maybe [(Entity, Rel c)])
tryGetRelCollectionFromTables :: forall c.
Component c =>
Tables
-> Entity
-> EntityPointer
-> ComponentId
-> IO (Maybe [(Entity, Rel c)])
tryGetRelCollectionFromTables (Tables IOVec Table
tables) Entity
entity (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) ComponentId
componentId =
  do
    table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables (Int# -> Int
I# Int#
archetypeId)
    tryGetRelCollectionFromTable table entity (EntityPointer (# archetypeId, rowIndex #)) componentId

tryGetComponentFromTables :: forall c. (Component c) => Tables -> EntityPointer -> ComponentId -> IO (Maybe c)
tryGetComponentFromTables :: forall c.
Component c =>
Tables -> EntityPointer -> ComponentId -> IO (Maybe c)
tryGetComponentFromTables (Tables IOVec Table
tables) (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) ComponentId
componentId =
  do
    table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables (Int# -> Int
I# Int#
archetypeId)
    tryGetComponentFromTable table (EntityPointer (# archetypeId, rowIndex #)) componentId

-- tryGetEntityTicksFromColumn :: Column -> EntityPointer -> IO ComponentTicks
-- tryGetEntityTicksFromColumn (Column components) (EntityPointer (# _, rowIndex #)) = (\x -> x.ticks) <$> Vec.unsafeRead components (I# rowIndex)

tryGetTicksFromTable :: Table -> ComponentId -> IO (Maybe ComponentTick)
tryGetTicksFromTable :: Table -> ComponentId -> IO (Maybe ComponentTick)
tryGetTicksFromTable Table
table ComponentId
componentId = do
  ticks <- IORef (Map ComponentId ComponentTick)
-> IO (Map ComponentId ComponentTick)
forall a. IORef a -> IO a
readIORef Table
table.ticks
  pure $ Map.lookup componentId ticks

-- do
--   columns <- readIORef table.columns
--   case Map.lookup componentId columns of
--     Nothing -> do
--       l <- Vec.length table.entities
--       return $ map (const Nothing) [1 .. l]
--     Just column -> do
--       map Just <$> tryGetTicksFromColumn column

-- tryGetEntityTicksFromTable :: Table -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
-- tryGetEntityTicksFromTable table pointer componentId =
--   do
--     columns <- readIORef table.columns
--     case Map.lookup componentId columns of
--       Nothing -> return Nothing
--       Just column -> Just <$> tryGetEntityTicksFromColumn column pointer

tryGetTicksFromArchetype :: ArchetypeId -> IOVec Table -> ComponentId -> IO (Maybe ComponentTick)
tryGetTicksFromArchetype :: ArchetypeId
-> IOVec Table -> ComponentId -> IO (Maybe ComponentTick)
tryGetTicksFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId = do
  table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
  tryGetTicksFromTable table componentId

-- tryGetEntityTicksFromArchetype :: ArchetypeId -> IOVec Table -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
-- tryGetEntityTicksFromArchetype archetype tables pointer componentId = do
--   table <- Vec.unsafeRead tables archetype.id
--   tryGetEntityTicksFromTable table pointer componentId

tryGetTicksFromTables :: Tables -> [ArchetypeId] -> ComponentId -> IO [Maybe ComponentTick]
tryGetTicksFromTables :: Tables -> [ArchetypeId] -> ComponentId -> IO [Maybe ComponentTick]
tryGetTicksFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
  (ArchetypeId -> IO (Maybe ComponentTick))
-> [ArchetypeId] -> IO [Maybe ComponentTick]
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
archetype -> ArchetypeId
-> IOVec Table -> ComponentId -> IO (Maybe ComponentTick)
tryGetTicksFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes

-- tryGetEntityTicksFromTables :: Tables -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
-- tryGetEntityTicksFromTables (Tables tables) (EntityPointer (# archetypeId, rowIndex #)) componentId =
--   do
--     tryGetEntityTicksFromArchetype (ArchetypeId $ I# archetypeId) tables (EntityPointer (# archetypeId, rowIndex #)) componentId

tryGetComponentsFromColumn :: forall c. (Component c) => Column -> IO [c]
tryGetComponentsFromColumn :: forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn (Column IOVec ErasedComponent
components) = do
  frozen <- Vec (PrimState IO) ErasedComponent -> IO (Vector ErasedComponent)
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> m (Vector a)
Vec.freeze IOVec ErasedComponent
Vec (PrimState IO) ErasedComponent
components
  let x = (ErasedComponent -> Maybe c)
-> Vector ErasedComponent -> Maybe (Vector c)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
Vector.mapM ErasedComponent -> Maybe c
forall c. Component c => ErasedComponent -> Maybe c
tryGetComponent Vector ErasedComponent
frozen
  pure $ maybe [] Vector.toList x

tryGetRelCollectionsFromTable :: forall c. (Component c) => Table -> ComponentId -> IO [(Entity, [Rel c])]
tryGetRelCollectionsFromTable :: forall c.
Component c =>
Table -> ComponentId -> IO [(Entity, [Rel c])]
tryGetRelCollectionsFromTable Table
table (ComponentId (# Word#
id, Maybe Entity
_ #)) =
  do
    -- let Just entity = componentId.entity
    columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
    -- TODO: improve lookup performance for partial tuples

    components' :: [Maybe [(c, Entity)]] <- forM (Map.toList columns) $ \(ComponentId (# Word#
id', Maybe Entity
target' #), Column
column) -> do
      if Int# -> Bool
isTrue# (Int# -> Bool) -> Int# -> Bool
forall a b. (a -> b) -> a -> b
$ Word# -> Word# -> Int#
eqWord# Word#
id Word#
id'
        then do
          case Maybe Entity
target' of
            Maybe Entity
Nothing -> Maybe [(c, Entity)] -> IO (Maybe [(c, Entity)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(c, Entity)]
forall a. Maybe a
Nothing
            Just Entity
entity -> do
              components <- forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn @c Column
column
              return $ Just $ map (,entity) components
        else Maybe [(c, Entity)] -> IO (Maybe [(c, Entity)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(c, Entity)]
forall a. Maybe a
Nothing

    entities <- Vec.toList table.entities
    let components'' = [Entity] -> [[(c, Entity)]] -> [(Entity, [(c, Entity)])]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Entity, IORef EntityPointer) -> Entity)
-> [(Entity, IORef EntityPointer)] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Entity, IORef EntityPointer) -> Entity
forall a b. (a, b) -> a
fst [(Entity, IORef EntityPointer)]
entities) ([[(c, Entity)]] -> [(Entity, [(c, Entity)])])
-> [[(c, Entity)]] -> [(Entity, [(c, Entity)])]
forall a b. (a -> b) -> a -> b
$ [[(c, Entity)]] -> [[(c, Entity)]]
forall a. [[a]] -> [[a]]
transpose ([[(c, Entity)]] -> [[(c, Entity)]])
-> [[(c, Entity)]] -> [[(c, Entity)]]
forall a b. (a -> b) -> a -> b
$ [Maybe [(c, Entity)]] -> [[(c, Entity)]]
forall a. [Maybe a] -> [a]
catMaybes [Maybe [(c, Entity)]]
components'
    return $
      map
        (Data.Bifunctor.second (map (uncurry Rel)))
        components''

tryGetComponentsFromTable :: forall c. (Component c) => Table -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromTable :: forall c. Component c => Table -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromTable Table
table ComponentId
componentId =
  do
    columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
    case Map.lookup componentId columns of
      Maybe Column
Nothing -> IO [(Entity, c)]
forall a. HasCallStack => a
undefined
      Just Column
column -> do
        results <- forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn @c Column
column
        entities <- Vec.toList table.entities
        let zipped = [Entity] -> [c] -> [(Entity, c)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Entity, IORef EntityPointer) -> Entity)
-> [(Entity, IORef EntityPointer)] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Entity, IORef EntityPointer) -> Entity
forall a b. (a, b) -> a
fst [(Entity, IORef EntityPointer)]
entities) [c]
results
        return $ map (\(Entity
e, c
r) -> (Entity
e, c
r)) zipped

tryGetEntitiesFromTable :: Table -> IO [Entity]
tryGetEntitiesFromTable :: Table -> IO [Entity]
tryGetEntitiesFromTable Table
table =
  do
    entities <- Vec (PrimState IO) (Entity, IORef EntityPointer)
-> IO [(Entity, IORef EntityPointer)]
forall (m :: * -> *) a. PrimMonad m => Vec (PrimState m) a -> m [a]
Vec.toList Table
table.entities
    return $ map fst entities

tryGetComponentsFromTableMaybe :: forall c. (Component c) => Table -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromTableMaybe :: forall c.
Component c =>
Table -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromTableMaybe Table
table ComponentId
componentId =
  do
    columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
    case Map.lookup componentId columns of
      Maybe Column
Nothing -> do
        entities <- Vec (PrimState IO) (Entity, IORef EntityPointer)
-> IO [(Entity, IORef EntityPointer)]
forall (m :: * -> *) a. PrimMonad m => Vec (PrimState m) a -> m [a]
Vec.toList Table
table.entities
        return $ map ((,Nothing) . fst) entities
      Just Column
column -> do
        results <- forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn @c Column
column
        entities <- Vec.toList table.entities
        return $ zipWith (\c
x Entity
e -> (Entity
e, c -> Maybe c
forall a. a -> Maybe a
Just c
x)) results (map fst entities)

tryGetRelCollectionsFromArchetype :: forall c. (Component c) => ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, [Rel c])]
tryGetRelCollectionsFromArchetype :: forall c.
Component c =>
ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, [Rel c])]
tryGetRelCollectionsFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId = do
  table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
  tryGetRelCollectionsFromTable table componentId

tryGetComponentsFromArchetype :: forall c. (Component c) => ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromArchetype :: forall c.
Component c =>
ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId = do
  table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
  tryGetComponentsFromTable table componentId

tryGetEntitiesFromArchetype :: ArchetypeId -> IOVec Table -> IO [Entity]
tryGetEntitiesFromArchetype :: ArchetypeId -> IOVec Table -> IO [Entity]
tryGetEntitiesFromArchetype ArchetypeId
archetype IOVec Table
tables = do
  table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
  tryGetEntitiesFromTable table

tryGetComponentsFromArchetypeMaybe :: forall c. (Component c) => ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromArchetypeMaybe :: forall c.
Component c =>
ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromArchetypeMaybe ArchetypeId
archetype IOVec Table
tables ComponentId
componentId = do
  table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
  tryGetComponentsFromTableMaybe table componentId

tryGetRelCollectionsFromTables :: forall c. (Component c) => Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, [Rel c])]
tryGetRelCollectionsFromTables :: forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, [Rel c])]
tryGetRelCollectionsFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
  do
    results <- (ArchetypeId -> IO [(Entity, [Rel c])])
-> [ArchetypeId] -> IO [[(Entity, [Rel c])]]
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
archetype -> ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, [Rel c])]
forall c.
Component c =>
ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, [Rel c])]
tryGetRelCollectionsFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes
    return $ concat results

tryGetComponentsFromTables :: forall c. (Component c) => Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromTables :: forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
  do
    results <- (ArchetypeId -> IO [(Entity, c)])
-> [ArchetypeId] -> IO [[(Entity, c)]]
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
archetype -> ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, c)]
forall c.
Component c =>
ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes
    return $ concat results

tryGetEntitiesFromTables :: Tables -> [ArchetypeId] -> IO [Entity]
tryGetEntitiesFromTables :: Tables -> [ArchetypeId] -> IO [Entity]
tryGetEntitiesFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes =
  do
    results <- (ArchetypeId -> IO [Entity]) -> [ArchetypeId] -> IO [[Entity]]
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 -> IOVec Table -> IO [Entity]
`tryGetEntitiesFromArchetype` IOVec Table
tables) [ArchetypeId]
archetypes
    return $ concat results

tryGetComponentsFromTablesMaybe :: forall c. (Component c) => Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromTablesMaybe :: forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromTablesMaybe (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
  do
    results <- (ArchetypeId -> IO [(Entity, Maybe c)])
-> [ArchetypeId] -> IO [[(Entity, Maybe c)]]
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
archetype -> ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, Maybe c)]
forall c.
Component c =>
ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromArchetypeMaybe ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes
    return $ concat results

-- newtype Result c = Result (c, Entity)

-- data ErasedResult where
--   ErasedResult :: Result c -> ErasedResult

-- value :: Result c -> c
-- value (Result (c, _)) = c

-- type family IsComp a where
--   IsComp (Rel a) = False
--   IsComp a = True

-- entityOf :: Result c -> Entity
-- entityOf (Result (_, e)) = e

-- instance (Show c) => Show (Result c) where
--   show :: Result c -> String
--   show = show . value

-- instance (Eq c) => Eq (Result c) where
--   (==) :: Result c -> Result c -> Bool
--   (==) a b = value a == value b

-- instance (Ord c) => Ord (Result c) where
--   compare :: Result c -> Result c -> Ordering
--   compare a b = compare (value a) (value b)

-- instance (HasField a b c) => HasField a (Result b) c where
--   getField a = getField @a (value a)

-- class DeepValue' flag c i | flag c -> i where
--   deepValue' :: c -> i

-- instance DeepValue' True (Result c) c where
--   deepValue' = value

-- instance DeepValue' False (Result (Rel c)) c where
--   deepValue' x = x.comp

-- class DeepValue c i | c -> i where
--   deepValue :: c -> i

-- instance (DeepValue' (IsComp c) (Result c) i) => DeepValue (Result c) i where
--   deepValue = deepValue' @(IsComp c)