{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.World.Utils where

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Bifunctor qualified
import Data.IORef
import Data.Proxy
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Typeable
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Spawn
import Mischief.ECS.Entities
import Mischief.ECS.Tables
import Mischief.ECS.World

-- | Process a 'BundleElement', turning its 'TypeRep' into a 'ComponentId'.
processBundleElement :: World -> BundleElement ErasedComponent -> IO ProcessedBundleElement
processBundleElement :: World -> BundleElement ErasedComponent -> IO ProcessedBundleElement
processBundleElement !World
world BundleElement {rep :: forall e. BundleElement e -> ComponentRep
rep = (ComponentRep !ComponentType
r), component :: forall e. BundleElement e -> e
component = !ErasedComponent
component} =
  do
    !id <- System ComponentId -> World -> IO ComponentId
forall a. System a -> World -> IO a
runSystem (ComponentType -> System ComponentId
getOrAddComponentId ComponentType
r) World
world
    pure
      ProcessedBundleElement
        { id,
          component
        }
processBundleElement !World
world BundleElement {rep :: forall e. BundleElement e -> ComponentRep
rep = (PairRep (!ComponentType
r, !Entity
entity)), component :: forall e. BundleElement e -> e
component = !ErasedComponent
component} =
  do
    !id <- System ComponentId -> World -> IO ComponentId
forall a. System a -> World -> IO a
runSystem (Pair -> System ComponentId
getOrAddPairId ((ComponentType, Entity) -> Pair
Pair (ComponentType
r, Entity
entity))) World
world
    pure
      ProcessedBundleElement
        { id,
          component
        }

-- | Process a set of 'BundleElement's into a 'ProcessedBundleData'.
processBundleElements :: World -> Set (BundleElement ErasedComponent) -> IO ProcessedBundleData
processBundleElements :: World
-> Set (BundleElement ErasedComponent) -> IO ProcessedBundleData
processBundleElements !World
world !Set (BundleElement ErasedComponent)
elements =
  do
    !elements <- (BundleElement ErasedComponent -> IO ProcessedBundleElement)
-> [BundleElement ErasedComponent] -> IO [ProcessedBundleElement]
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 (World -> BundleElement ErasedComponent -> IO ProcessedBundleElement
processBundleElement World
world) (Set (BundleElement ErasedComponent)
-> [BundleElement ErasedComponent]
forall a. Set a -> [a]
Set.toList Set (BundleElement ErasedComponent)
elements)
    pure
      ProcessedBundleData {elements}

-- | Combine two 'ProcessedBundleData's, merging their sets of elements.
combineProcessedBundles :: ProcessedBundleData -> ProcessedBundleData -> ProcessedBundleData
combineProcessedBundles :: ProcessedBundleData -> ProcessedBundleData -> ProcessedBundleData
combineProcessedBundles !ProcessedBundleData
bundle1 !ProcessedBundleData
bundle2 =
  let !elements :: [ProcessedBundleElement]
elements = Set ProcessedBundleElement -> [ProcessedBundleElement]
forall a. Set a -> [a]
Set.toList (Set ProcessedBundleElement -> [ProcessedBundleElement])
-> Set ProcessedBundleElement -> [ProcessedBundleElement]
forall a b. (a -> b) -> a -> b
$ Set ProcessedBundleElement
-> Set ProcessedBundleElement -> Set ProcessedBundleElement
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([ProcessedBundleElement] -> Set ProcessedBundleElement
forall a. Ord a => [a] -> Set a
Set.fromList ProcessedBundleData
bundle1.elements) ([ProcessedBundleElement] -> Set ProcessedBundleElement
forall a. Ord a => [a] -> Set a
Set.fromList ProcessedBundleData
bundle2.elements)
   in ProcessedBundleData {[ProcessedBundleElement]
elements :: [ProcessedBundleElement]
elements :: [ProcessedBundleElement]
elements}

-- | Check if a 'ComponentId' is inside a 'ProcessedBundleData'.
isInProcessedBundle :: ProcessedBundleData -> ComponentId -> Bool
isInProcessedBundle :: ProcessedBundleData -> ComponentId -> Bool
isInProcessedBundle ProcessedBundleData {elements :: ProcessedBundleData -> [ProcessedBundleElement]
elements = ![ProcessedBundleElement]
elements} !ComponentId
id = ComponentId
id ComponentId -> [ComponentId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ProcessedBundleElement -> ComponentId)
-> [ProcessedBundleElement] -> [ComponentId]
forall a b. (a -> b) -> [a] -> [b]
map (.id) [ProcessedBundleElement]
elements

-- | Sets the change tick of certain elements of the bundle to the specified 'Tick'.
-- setChangedTickOfComponents :: ProcessedBundleData -> (ComponentId -> Bool) -> Tick -> ProcessedBundleData
-- setChangedTickOfComponents ProcessedBundleData {elements = !elements} !shouldChange !tick =
--   ProcessedBundleData
--     { elements =
--         map
--           ( \ProcessedBundleElement {id = !id, component = ComponentData {value = !value, ticks = ComponentTicks {added = !added, changed = !changed}}} ->
--               if shouldChange id
--                 then ProcessedBundleElement {id, component = ComponentData {value, ticks = ComponentTicks {added, changed = tick}}}
--                 else ProcessedBundleElement {id, component = ComponentData {value, ticks = ComponentTicks {added, changed}}}
--           )
--           elements
--     }

-- | Sets the added tick of certain elements of the bundle to the specified 'Tick'.
-- setAddedTickOfComponents :: ProcessedBundleData -> (ComponentId -> Bool) -> Tick -> ProcessedBundleData
-- setAddedTickOfComponents ProcessedBundleData {elements = !elements} !shouldChange !tick =
--   ProcessedBundleData
--     { elements =
--         map
--           ( \ProcessedBundleElement {id = !id, component = ComponentData {value = !value, ticks = ComponentTicks {added = !added, changed = !changed}}} ->
--               if shouldChange id
--                 then ProcessedBundleElement {id, component = ComponentData {value, ticks = ComponentTicks {added = tick, changed}}}
--                 else ProcessedBundleElement {id, component = ComponentData {value, ticks = ComponentTicks {added, changed}}}
--           )
--           elements
--     }
removeComponentFromProcessedBundle :: ComponentId -> ProcessedBundleData -> ProcessedBundleData
removeComponentFromProcessedBundle :: ComponentId -> ProcessedBundleData -> ProcessedBundleData
removeComponentFromProcessedBundle !ComponentId
componentId !ProcessedBundleData
bundle =
  do
    let elements :: [ProcessedBundleElement]
elements = (ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> [ProcessedBundleElement]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
/= ComponentId
componentId) (ComponentId -> Bool)
-> (ProcessedBundleElement -> ComponentId)
-> ProcessedBundleElement
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.id)) ProcessedBundleData
bundle.elements
     in ProcessedBundleData {[ProcessedBundleElement]
elements :: [ProcessedBundleElement]
elements :: [ProcessedBundleElement]
elements}

tryGetEntityRelCollection :: forall c. (Component c) => World -> Entity -> IO (Maybe (Maybe [Rel c]))
tryGetEntityRelCollection :: forall c.
Component c =>
World -> Entity -> IO (Maybe (Maybe [Rel c]))
tryGetEntityRelCollection !World
world !Entity
entity =
  do
    !componentId <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) World
world.components
    case componentId of
      Maybe ComponentId
Nothing -> Maybe (Maybe [Rel c]) -> IO (Maybe (Maybe [Rel c]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe [Rel c])
forall a. Maybe a
Nothing
      Just !ComponentId
componentId -> do
        !pointer <- Entity -> Entities -> IO (Maybe (IORef EntityPointer))
getPointer Entity
entity World
world.entities
        case pointer of
          Maybe (IORef EntityPointer)
Nothing -> do
            Maybe (Maybe [Rel c]) -> IO (Maybe (Maybe [Rel c]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe [Rel c])
forall a. Maybe a
Nothing
          Just !IORef EntityPointer
pointer ->
            do
              !pointer <- IORef EntityPointer -> IO EntityPointer
forall a. IORef a -> IO a
readIORef IORef EntityPointer
pointer
              !res <- tryGetRelCollectionFromTables world.tables entity pointer componentId
              pure $ Just $ fmap (map snd) res

tryGetEntityComponent :: forall c. (Component c) => World -> Entity -> IO (Maybe (Maybe c))
tryGetEntityComponent :: forall c. Component c => World -> Entity -> IO (Maybe (Maybe c))
tryGetEntityComponent !World
world !Entity
entity =
  do
    !pointer <- Entity -> Entities -> IO (Maybe (IORef EntityPointer))
getPointer Entity
entity World
world.entities

    case pointer of
      Maybe (IORef EntityPointer)
Nothing -> Maybe (Maybe c) -> IO (Maybe (Maybe c))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe c)
forall a. Maybe a
Nothing
      Just !IORef EntityPointer
pointer ->
        do
          !componentId <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) World
world.components
          case componentId of
            Maybe ComponentId
Nothing -> Maybe (Maybe c) -> IO (Maybe (Maybe c))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Maybe c) -> IO (Maybe (Maybe c)))
-> Maybe (Maybe c) -> IO (Maybe (Maybe c))
forall a b. (a -> b) -> a -> b
$ Maybe c -> Maybe (Maybe c)
forall a. a -> Maybe a
Just Maybe c
forall a. Maybe a
Nothing
            Just !ComponentId
componentId -> do
              !pointer <- IORef EntityPointer -> IO EntityPointer
forall a. IORef a -> IO a
readIORef IORef EntityPointer
pointer
              !res <- tryGetComponentFromTables world.tables pointer componentId
              pure $ Just res

tryGetEntityRel :: forall c. (Component c) => Entity -> World -> Entity -> IO (Maybe (Maybe c))
tryGetEntityRel :: forall c.
Component c =>
Entity -> World -> Entity -> IO (Maybe (Maybe c))
tryGetEntityRel !Entity
target !World
world !Entity
entity =
  do
    !pointer <- Entity -> Entities -> IO (Maybe (IORef EntityPointer))
getPointer Entity
entity World
world.entities

    case pointer of
      Maybe (IORef EntityPointer)
Nothing -> Maybe (Maybe c) -> IO (Maybe (Maybe c))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe c)
forall a. Maybe a
Nothing
      Just !IORef EntityPointer
pointer ->
        do
          !componentId <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) World
world.components
          case componentId of
            Maybe ComponentId
Nothing -> Maybe (Maybe c) -> IO (Maybe (Maybe c))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe c)
forall a. Maybe a
Nothing
            Just (ComponentId (# !Word#
id, Maybe Entity
_ #)) -> do
              !pointer <- IORef EntityPointer -> IO EntityPointer
forall a. IORef a -> IO a
readIORef IORef EntityPointer
pointer
              !res <- tryGetComponentFromTables world.tables pointer (ComponentId (# id, Just target #))
              pure $ Just res

tryGetRelCollections :: forall c. (Component c) => World -> [ArchetypeId] -> IO [(Entity, [Rel c])]
tryGetRelCollections :: forall c.
Component c =>
World -> [ArchetypeId] -> IO [(Entity, [Rel c])]
tryGetRelCollections !World
world ![ArchetypeId]
archetypes =
  do
    !componentId <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) World
world.components
    case componentId of
      Maybe ComponentId
Nothing -> [(Entity, [Rel c])] -> IO [(Entity, [Rel c])]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just !ComponentId
componentId ->
        Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, [Rel c])]
forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, [Rel c])]
tryGetRelCollectionsFromTables World
world.tables [ArchetypeId]
archetypes ComponentId
componentId

tryGetComponents :: forall c. (Component c) => World -> [ArchetypeId] -> IO [(Entity, c)]
tryGetComponents :: forall c. Component c => World -> [ArchetypeId] -> IO [(Entity, c)]
tryGetComponents !World
world ![ArchetypeId]
archetypes =
  do
    !componentId <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) World
world.components
    case componentId of
      Maybe ComponentId
Nothing -> [(Entity, c)] -> IO [(Entity, c)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just !ComponentId
componentId ->
        Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, c)]
forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromTables World
world.tables [ArchetypeId]
archetypes ComponentId
componentId

tryGetEntities :: World -> [ArchetypeId] -> IO [Entity]
tryGetEntities :: World -> [ArchetypeId] -> IO [Entity]
tryGetEntities !World
world = Tables -> [ArchetypeId] -> IO [Entity]
tryGetEntitiesFromTables World
world.tables

tryGetRels :: forall c. (Component c) => Entity -> World -> [ArchetypeId] -> IO [(Entity, Rel c)]
tryGetRels :: forall c.
Component c =>
Entity -> World -> [ArchetypeId] -> IO [(Entity, Rel c)]
tryGetRels !Entity
target !World
world ![ArchetypeId]
archetypes =
  do
    !componentId <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) World
world.components
    case componentId of
      Maybe ComponentId
Nothing -> [(Entity, Rel c)] -> IO [(Entity, Rel c)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just !ComponentId
componentId -> do
        !res <- Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, c)]
forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, c)]
tryGetComponentsFromTables World
world.tables [ArchetypeId]
archetypes (Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
target) ComponentId
componentId) -- {entity = Just target}
        pure $ map (\(!Entity
e, !c
res) -> (Entity
e, c -> Entity -> Rel c
forall c. c -> Entity -> Rel c
Rel c
res Entity
target)) res

tryGetRelsMaybe :: forall c. (Component c) => Entity -> World -> [ArchetypeId] -> IO [(Entity, Maybe (Rel c))]
tryGetRelsMaybe :: forall c.
Component c =>
Entity -> World -> [ArchetypeId] -> IO [(Entity, Maybe (Rel c))]
tryGetRelsMaybe !Entity
target !World
world ![ArchetypeId]
archetypes =
  do
    !componentId <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) World
world.components
    case componentId of
      Maybe ComponentId
Nothing -> do
        !e <- World -> [ArchetypeId] -> IO [Entity]
tryGetEntities World
world [ArchetypeId]
archetypes
        pure $ map (,Nothing) e
      Just !ComponentId
componentId -> do
        !res <- Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Maybe c)]
forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromTablesMaybe World
world.tables [ArchetypeId]
archetypes (Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
target) ComponentId
componentId) -- {entity = Just target}
        pure $
          map
            ( Data.Bifunctor.second
                (fmap (`Rel` target))
            )
            res

tryGetComponentsMaybe :: forall c. (Component c) => World -> [ArchetypeId] -> IO [(Entity, Maybe c)]
tryGetComponentsMaybe :: forall c.
Component c =>
World -> [ArchetypeId] -> IO [(Entity, Maybe c)]
tryGetComponentsMaybe !World
world ![ArchetypeId]
archetypes =
  do
    !componentId <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId (Proxy c -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy c -> TypeRep) -> Proxy c -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) World
world.components
    case componentId of
      Maybe ComponentId
Nothing -> do
        !e <- World -> [ArchetypeId] -> IO [Entity]
tryGetEntities World
world [ArchetypeId]
archetypes
        pure $ map (,Nothing) e
      Just !ComponentId
componentId ->
        Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Maybe c)]
forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Maybe c)]
tryGetComponentsFromTablesMaybe World
world.tables [ArchetypeId]
archetypes ComponentId
componentId

tryGetTicks :: ComponentId -> World -> [ArchetypeId] -> IO [Maybe ComponentTick]
tryGetTicks :: ComponentId -> World -> [ArchetypeId] -> IO [Maybe ComponentTick]
tryGetTicks !ComponentId
componentId !World
world ![ArchetypeId]
archetypes = Tables -> [ArchetypeId] -> ComponentId -> IO [Maybe ComponentTick]
tryGetTicksFromTables World
world.tables [ArchetypeId]
archetypes ComponentId
componentId

-- tryGetEntityTicks :: Entity -> ComponentId -> World -> IO (Maybe ComponentTicks)
-- tryGetEntityTicks !entity !componentId !world = do
--   !pointer <- getPointer entity world.entities
--   case pointer of
--     Nothing -> pure Nothing
--     Just !pointer -> do
--       !pointer <- readIORef pointer
--       tryGetEntityTicksFromTables world.tables pointer componentId

isAlive :: forall m w. (MonadSystem w m) => Entity -> m Bool
isAlive :: forall (m :: * -> *) w. MonadSystem w m => Entity -> m Bool
isAlive !Entity
entity = do
  !world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  liftIO $ isAliveIO entity world.entities

newtype GetSystem = GetSystem (forall c. (Component c) => Proxy c -> Entity -> System (Maybe c))