module Mischief.ECS.World.Change where

import Control.Monad.Reader (MonadIO (liftIO))
import Data.Foldable
import Data.IORef
import Data.Maybe
import Data.Set qualified as Set
import GHC.Base (Int (..))
import GHC.Stack (HasCallStack)
import Mischief.ECS.App.SystemDef
import Mischief.ECS.Archetypes
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Entities
import Mischief.ECS.Tables
import Mischief.ECS.Vec qualified as Vec
import Mischief.ECS.World
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers

data ChangeResult = ChangeResult
  { ChangeResult -> [ProcessedBundleElement]
requiredComponentsAdded :: [ProcessedBundleElement],
    ChangeResult -> [ProcessedBundleElement]
newComponents :: [ProcessedBundleElement]
  }

changeArchetype :: (HasCallStack) => Entity -> ArchetypeData -> Maybe ProcessedBundleData -> System ChangeResult
changeArchetype :: HasCallStack =>
Entity
-> ArchetypeData
-> Maybe ProcessedBundleData
-> System ChangeResult
changeArchetype !Entity
entity !ArchetypeData
newArchetype !Maybe ProcessedBundleData
insertedBundle = do
  !world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  !currentTick <- liftIO $ readIORef world.tick

  !reqAdded <- liftIO $ newIORef []
  !newAdded <- liftIO $ newIORef []

  Just !pointer <- liftIO $ getPointer entity world.entities
  (EntityPointer (# !archetypeId', !rowIndex' #)) <- liftIO $ readIORef pointer

  !table <- Vec.read world.tables.inner (I# archetypeId')

  !collected <- liftIO $ takeComponentsFromTable (EntityPointer (# archetypeId', rowIndex' #)) table

  -- TODO OPT: this whole thing can be greatly optimized
  !newElements'' <-
    mapM
      ( \(!ComponentId
component) -> do
          case Maybe ProcessedBundleData
insertedBundle of
            Maybe ProcessedBundleData
Nothing -> System ProcessedBundleElement
-> (ProcessedBundleElement -> System ProcessedBundleElement)
-> Maybe ProcessedBundleElement
-> System ProcessedBundleElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe System ProcessedBundleElement
forall a. HasCallStack => a
undefined ProcessedBundleElement -> System ProcessedBundleElement
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> Maybe ProcessedBundleElement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(!ProcessedBundleElement
x) -> ProcessedBundleElement
x.id ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId
component) ProcessedBundleData
collected.elements)
            Just !ProcessedBundleData
bundle ->
              case (ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> Maybe ProcessedBundleElement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(!ProcessedBundleElement
x) -> ProcessedBundleElement
x.id ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId
component) ProcessedBundleData
bundle.elements of
                Just !ProcessedBundleElement
x -> do
                  case (ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> Maybe ProcessedBundleElement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(!ProcessedBundleElement
x) -> ProcessedBundleElement
x.id ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId
component) ProcessedBundleData
collected.elements of
                    Maybe ProcessedBundleElement
Nothing -> do
                      IO () -> System ()
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> System ()) -> IO () -> System ()
forall a b. (a -> b) -> a -> b
$ IORef [ProcessedBundleElement]
-> ([ProcessedBundleElement] -> [ProcessedBundleElement]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [ProcessedBundleElement]
newAdded ([ProcessedBundleElement]
-> [ProcessedBundleElement] -> [ProcessedBundleElement]
forall a. [a] -> [a] -> [a]
++ [ProcessedBundleElement
x])
                    Just ProcessedBundleElement
_ -> () -> System ()
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  ProcessedBundleElement -> System ProcessedBundleElement
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProcessedBundleElement
x
                Maybe ProcessedBundleElement
Nothing ->
                  case (ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> Maybe ProcessedBundleElement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(!ProcessedBundleElement
x) -> ProcessedBundleElement
x.id ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId
component) ProcessedBundleData
collected.elements of
                    Just !ProcessedBundleElement
x -> ProcessedBundleElement -> System ProcessedBundleElement
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessedBundleElement
x
                    Maybe ProcessedBundleElement
Nothing -> do
                      !r <- ComponentId -> System ProcessedBundleElement
getDefault ComponentId
component
                      liftIO $ modifyIORef' reqAdded (++ [r])
                      pure r
      )
      $ Set.toList newArchetype.components

  -- let newElements = case insertedBundle of
  --       Nothing -> ProcessedBundleData newElements''
  --       Just bundle ->
  --         let !newElements' = setChangedTickOfComponents (ProcessedBundleData newElements'') (\(!id) -> isInProcessedBundle bundle id && isInProcessedBundle collected id) currentTick
  --          in setAddedTickOfComponents newElements' (\(!id) -> isInProcessedBundle bundle id && not (isInProcessedBundle collected id)) currentTick

  let newElements = [ProcessedBundleElement] -> ProcessedBundleData
ProcessedBundleData [ProcessedBundleElement]
newElements''

  !newComponents <- liftIO $ readIORef newAdded
  let changed = [ComponentId]
-> (ProcessedBundleData -> [ComponentId])
-> Maybe ProcessedBundleData
-> [ComponentId]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (((ProcessedBundleElement -> ComponentId)
-> [ProcessedBundleElement] -> [ComponentId]
forall a b. (a -> b) -> [a] -> [b]
map (.id)) ([ProcessedBundleElement] -> [ComponentId])
-> (ProcessedBundleData -> [ProcessedBundleElement])
-> ProcessedBundleData
-> [ComponentId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.elements)) Maybe ProcessedBundleData
insertedBundle [ComponentId] -> [ComponentId] -> [ComponentId]
forall a. [a] -> [a] -> [a]
++ (ProcessedBundleElement -> ComponentId)
-> [ProcessedBundleElement] -> [ComponentId]
forall a b. (a -> b) -> [a] -> [b]
map (.id) [ProcessedBundleElement]
newComponents

  -- warn $ T.show newArchetype.id
  -- warn $ T.show $ changed

  liftIO $ insertEntityIntoTables newElements currentTick changed world.tables newArchetype.id (entity, pointer)

  !requiredComponentsAdded <- liftIO $ readIORef reqAdded
  pure ChangeResult {requiredComponentsAdded, newComponents}

getDefault :: ComponentId -> System ProcessedBundleElement
getDefault :: ComponentId -> System ProcessedBundleElement
getDefault (ComponentId (# !Word#
id, !Maybe Entity
e #)) = do
  !world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld

  Just !x <- single $ mkGet (Entity (# id, 0## #)) (C @DefaultValue)
  let (DefaultValue !value) = x

  let (SystemId !sys) = world.systemId
  !currentSystemTick <- fromMaybe (SystemTick $ Tick 0) <$> single (mkGet sys (C @SystemTick))

  pure
    ProcessedBundleElement
      { id = ComponentId (# id, e #),
        component = value
      }