{-# 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 -> Vec RealWorld (Entity, IORef EntityPointer)
entities :: IOVec (Entity, IORef EntityPointer)
  }

newtype Column = Column (IOVec ComponentData)

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) ComponentData)
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

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

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 ComponentData
col) ->
      Vec (PrimState IO) ComponentData -> ComponentData -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> a -> m ()
Vec.pushBack IOVec ComponentData
Vec (PrimState IO) ComponentData
col ProcessedBundleElement
el.component

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

replaceComponentsIntoMap ::
  ProcessedBundleData ->
  -- | The current tick that will be as the components' change tick.
  Maybe Tick ->
  EntityPointer ->
  Map ComponentId Column ->
  IO ()
replaceComponentsIntoMap :: ProcessedBundleData
-> Maybe Tick -> EntityPointer -> Map ComponentId Column -> IO ()
replaceComponentsIntoMap ProcessedBundleData
bundle Maybe Tick
tick (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 ComponentData
col) ->
      case Maybe Tick
tick of
        Just Tick
tick ->
          Vec (PrimState IO) ComponentData
-> Int -> (ComponentData -> ComponentData) -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> (a -> a) -> m ()
Vec.modify_ IOVec ComponentData
Vec (PrimState IO) ComponentData
col (Int# -> Int
I# Int#
rowIndex) (\ComponentData {ticks :: ComponentData -> ComponentTicks
ticks = ComponentTicks {Tick
added :: Tick
added :: ComponentTicks -> Tick
added}} -> ComponentData {value :: ErasedComponent
value = ProcessedBundleElement
el.component.value, ticks :: ComponentTicks
ticks = ComponentTicks {changed :: Tick
changed = Tick
tick, Tick
added :: Tick
added :: Tick
added}})
        Maybe Tick
Nothing ->
          Vec (PrimState IO) ComponentData
-> Int -> (ComponentData -> ComponentData) -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> (a -> a) -> m ()
Vec.modify_ IOVec ComponentData
Vec (PrimState IO) ComponentData
col (Int# -> Int
I# Int#
rowIndex) (\ComponentData {ComponentTicks
ticks :: ComponentData -> ComponentTicks
ticks :: ComponentTicks
ticks} -> ComponentData {value :: ErasedComponent
value = ProcessedBundleElement
el.component.value, ComponentTicks
ticks :: ComponentTicks
ticks :: ComponentTicks
ticks})

--   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
  cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
  replaceComponentsIntoMap bundle tick pointer cols

takeFromColumn :: EntityPointer -> Column -> IO ComponentData
takeFromColumn :: EntityPointer -> Column -> IO ComponentData
takeFromColumn (EntityPointer (# Int#
_, Int#
rowIndex #)) (Column IOVec ComponentData
col) = Vec (PrimState IO) ComponentData -> Int -> IO ComponentData
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.takeSwap IOVec ComponentData
Vec (PrimState IO) ComponentData
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, ComponentData) -> ProcessedBundleElement)
-> [(ComponentId, ComponentData)] -> [ProcessedBundleElement]
forall a b. (a -> b) -> [a] -> [b]
map ((ComponentId -> ComponentData -> ProcessedBundleElement)
-> (ComponentId, ComponentData) -> ProcessedBundleElement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ComponentId -> ComponentData -> ProcessedBundleElement
ProcessedBundleElement) ([(ComponentId, ComponentData)] -> [ProcessedBundleElement])
-> [(ComponentId, ComponentData)] -> [ProcessedBundleElement]
forall a b. (a -> b) -> a -> b
$ Map ComponentId ComponentData -> [(ComponentId, ComponentData)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ComponentId ComponentData
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 ComponentData
col) = Vec (PrimState IO) ComponentData -> Int -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m ()
Vec.removeSwap IOVec ComponentData
Vec (PrimState IO) ComponentData
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

insertEntityIntoTables :: ProcessedBundleData -> Tables -> ArchetypeId -> (Entity, IORef EntityPointer) -> IO ()
insertEntityIntoTables :: ProcessedBundleData
-> Tables -> ArchetypeId -> (Entity, IORef EntityPointer) -> IO ()
insertEntityIntoTables ProcessedBundleData
bundle (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 table

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

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

tryGetTicksFromColumn :: Column -> IO [ComponentTicks]
tryGetTicksFromColumn :: Column -> IO [ComponentTicks]
tryGetTicksFromColumn (Column IOVec ComponentData
components) = do
  frozen <- Vec (PrimState IO) ComponentData -> IO (Vector ComponentData)
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> m (Vector a)
Vec.freeze IOVec ComponentData
Vec (PrimState IO) ComponentData
components
  let x = (ComponentData -> ComponentTicks)
-> Vector ComponentData -> Vector ComponentTicks
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (\ComponentData
x -> ComponentData
x.ticks) Vector ComponentData
frozen
  return $ Vector.toList x

tryGetEntityTicksFromColumn :: Column -> EntityPointer -> IO ComponentTicks
tryGetEntityTicksFromColumn :: Column -> EntityPointer -> IO ComponentTicks
tryGetEntityTicksFromColumn (Column IOVec ComponentData
components) (EntityPointer (# Int#
_, Int#
rowIndex #)) = (\ComponentData
x -> ComponentData
x.ticks) (ComponentData -> ComponentTicks)
-> IO ComponentData -> IO ComponentTicks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vec (PrimState IO) ComponentData -> Int -> IO ComponentData
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec ComponentData
Vec (PrimState IO) ComponentData
components (Int# -> Int
I# Int#
rowIndex)

tryGetTicksFromTable :: Table -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromTable :: Table -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromTable 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
        l <- Vec (PrimState IO) (Entity, IORef EntityPointer) -> IO Int
forall (m :: * -> *) a. PrimMonad m => Vec (PrimState m) a -> m Int
Vec.length Table
table.entities
        return $ map (const Nothing) [1 .. l]
      Just Column
column -> do
        (ComponentTicks -> Maybe ComponentTicks)
-> [ComponentTicks] -> [Maybe ComponentTicks]
forall a b. (a -> b) -> [a] -> [b]
map ComponentTicks -> Maybe ComponentTicks
forall a. a -> Maybe a
Just ([ComponentTicks] -> [Maybe ComponentTicks])
-> IO [ComponentTicks] -> IO [Maybe ComponentTicks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Column -> IO [ComponentTicks]
tryGetTicksFromColumn Column
column

tryGetEntityTicksFromTable :: Table -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromTable :: Table -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromTable 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
    case Map.lookup componentId columns of
      Maybe Column
Nothing -> Maybe ComponentTicks -> IO (Maybe ComponentTicks)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ComponentTicks
forall a. Maybe a
Nothing
      Just Column
column -> ComponentTicks -> Maybe ComponentTicks
forall a. a -> Maybe a
Just (ComponentTicks -> Maybe ComponentTicks)
-> IO ComponentTicks -> IO (Maybe ComponentTicks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Column -> EntityPointer -> IO ComponentTicks
tryGetEntityTicksFromColumn Column
column EntityPointer
pointer

tryGetTicksFromArchetype :: ArchetypeId -> IOVec Table -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromArchetype :: ArchetypeId
-> IOVec Table -> ComponentId -> IO [Maybe ComponentTicks]
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 :: ArchetypeId
-> IOVec Table
-> EntityPointer
-> ComponentId
-> IO (Maybe ComponentTicks)
tryGetEntityTicksFromArchetype ArchetypeId
archetype IOVec Table
tables EntityPointer
pointer 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
  tryGetEntityTicksFromTable table pointer componentId

tryGetTicksFromTables :: Tables -> [ArchetypeId] -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromTables :: Tables -> [ArchetypeId] -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
  do
    results <- (ArchetypeId -> IO [Maybe ComponentTicks])
-> [ArchetypeId] -> IO [[Maybe ComponentTicks]]
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 ComponentTicks]
tryGetTicksFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes
    return $ concat results

tryGetEntityTicksFromTables :: Tables -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromTables :: Tables -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromTables (Tables IOVec Table
tables) (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) ComponentId
componentId =
  do
    ArchetypeId
-> IOVec Table
-> EntityPointer
-> ComponentId
-> IO (Maybe ComponentTicks)
tryGetEntityTicksFromArchetype (Int -> ArchetypeId
ArchetypeId (Int -> ArchetypeId) -> Int -> ArchetypeId
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
archetypeId) IOVec Table
tables ((# Int#, Int# #) -> EntityPointer
EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) ComponentId
componentId

tryGetComponentsFromColumn :: forall c. (Component c) => Column -> IO [c]
tryGetComponentsFromColumn :: forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn (Column IOVec ComponentData
components) = do
  frozen <- Vec (PrimState IO) ComponentData -> IO (Vector ComponentData)
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> m (Vector a)
Vec.freeze IOVec ComponentData
Vec (PrimState IO) ComponentData
components
  let x = (ComponentData -> Maybe c)
-> Vector ComponentData -> Maybe (Vector c)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
Vector.mapM (\ComponentData
x -> ErasedComponent -> Maybe c
forall c. Component c => ErasedComponent -> Maybe c
tryGetComponent ComponentData
x.value) Vector ComponentData
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)