-- |

-- Module      : Aztecs.ECS.World.Bundle.Dynamic

-- Copyright   : (c) Matt Hunzinger, 2025

-- License     : BSD-style (see the LICENSE file in the distribution)

--

-- Maintainer  : matt@hunzinger.me

-- Stability   : provisional

-- Portability : non-portable (GHC extensions)

module Aztecs.ECS.World.Bundle.Dynamic (DynamicBundle (..), dynBundle) where

import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.World.Archetype

-- | Dynamic bundle of components.

--

-- @since 0.9

newtype DynamicBundle = DynamicBundle {DynamicBundle -> EntityID -> Archetype -> Archetype
runDynamicBundle :: EntityID -> Archetype -> Archetype}

-- | @since 0.9

instance Semigroup DynamicBundle where
  DynamicBundle EntityID -> Archetype -> Archetype
d1 <> :: DynamicBundle -> DynamicBundle -> DynamicBundle
<> DynamicBundle EntityID -> Archetype -> Archetype
d2 = (EntityID -> Archetype -> Archetype) -> DynamicBundle
DynamicBundle ((EntityID -> Archetype -> Archetype) -> DynamicBundle)
-> (EntityID -> Archetype -> Archetype) -> DynamicBundle
forall a b. (a -> b) -> a -> b
$ \EntityID
eId Archetype
arch -> EntityID -> Archetype -> Archetype
d2 EntityID
eId (EntityID -> Archetype -> Archetype
d1 EntityID
eId Archetype
arch)

-- | @since 0.9

instance Monoid DynamicBundle where
  mempty :: DynamicBundle
mempty = (EntityID -> Archetype -> Archetype) -> DynamicBundle
DynamicBundle ((EntityID -> Archetype -> Archetype) -> DynamicBundle)
-> (EntityID -> Archetype -> Archetype) -> DynamicBundle
forall a b. (a -> b) -> a -> b
$ \EntityID
_ Archetype
arch -> Archetype
arch

-- | @since 0.11

dynBundle :: (Component a) => ComponentID -> a -> DynamicBundle
dynBundle :: forall a. Component a => ComponentID -> a -> DynamicBundle
dynBundle ComponentID
cId a
a = (EntityID -> Archetype -> Archetype) -> DynamicBundle
DynamicBundle ((EntityID -> Archetype -> Archetype) -> DynamicBundle)
-> (EntityID -> Archetype -> Archetype) -> DynamicBundle
forall a b. (a -> b) -> a -> b
$ \EntityID
eId Archetype
arch -> EntityID -> ComponentID -> a -> Archetype -> Archetype
forall a.
Component a =>
EntityID -> ComponentID -> a -> Archetype -> Archetype
insertComponent EntityID
eId ComponentID
cId a
a Archetype
arch