module Mischief.ECS.Archetypes where

import Control.Monad
import Data.Foldable
import Data.IORef
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Mischief.ECS.Components
import Mischief.ECS.Vec
import Mischief.ECS.Vec qualified as Vec

newtype Archetypes = Archetypes {Archetypes -> ArchetypeGraph
graph :: ArchetypeGraph}

data ArchetypeGraph = ArchetypeGraph {ArchetypeGraph -> IOVec ArchetypeNode
nodes :: IOVec ArchetypeNode, ArchetypeGraph -> IORef (Map (Set ComponentId) Int)
lookup :: IORef (Map (Set ComponentId) Int), ArchetypeGraph -> IORef Int
counter :: IORef Int}

newArchetypeGraph :: IO ArchetypeGraph
newArchetypeGraph :: IO ArchetypeGraph
newArchetypeGraph = do
  nodes <- Int -> IO (Vec (PrimState IO) ArchetypeNode)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (Vec (PrimState m) a)
Vec.new Int
1024

  -- Add the empty archetype to the graph.
  Vec.pushBack nodes ArchetypeNode {archetype = ArchetypeData {id = ArchetypeId 0, components = Set.empty}, insert = Map.empty, remove = Map.empty}

  counter <- newIORef 1
  lookup <- newIORef $ Map.singleton Set.empty 0
  return $ ArchetypeGraph {nodes, lookup, counter}

data ArchetypeNode = ArchetypeNode
  { ArchetypeNode -> ArchetypeData
archetype :: ArchetypeData,
    ArchetypeNode -> Map ComponentId Int
insert :: Map ComponentId Int,
    ArchetypeNode -> Map ComponentId Int
remove :: Map ComponentId Int
  }

data ArchetypeData = ArchetypeData
  { ArchetypeData -> ArchetypeId
id :: ArchetypeId,
    ArchetypeData -> Set ComponentId
components :: Set ComponentId
  }

-- Construct an empty 'Archetypes'.
emptyArchetypes :: IO Archetypes
emptyArchetypes :: IO Archetypes
emptyArchetypes =
  ArchetypeGraph -> Archetypes
Archetypes (ArchetypeGraph -> Archetypes)
-> IO ArchetypeGraph -> IO Archetypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ArchetypeGraph
newArchetypeGraph