{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |

-- Module      : Aztecs.ECS.World.Bundle

-- 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
  ( Bundle (..),
    bundle,
    fromDynBundle,
    runBundle,
  )
where

import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.World.Archetype
import Aztecs.ECS.World.Bundle.Dynamic
import Aztecs.ECS.World.Components
import qualified Aztecs.ECS.World.Components as CS
import Data.Set (Set)
import qualified Data.Set as Set

-- | Bundle of components.

--

-- @since 0.9

newtype Bundle = Bundle
  { -- | Unwrap the bundle.

    --

    -- @since 0.9

    Bundle
-> Components -> (Set ComponentID, Components, DynamicBundle)
unBundle :: Components -> (Set ComponentID, Components, DynamicBundle)
  }

-- | @since 0.9

instance Monoid Bundle where
  mempty :: Bundle
mempty = (Components -> (Set ComponentID, Components, DynamicBundle))
-> Bundle
Bundle (Set ComponentID
forall a. Set a
Set.empty,,DynamicBundle
forall a. Monoid a => a
mempty)

-- | @since 0.9

instance Semigroup Bundle where
  Bundle Components -> (Set ComponentID, Components, DynamicBundle)
b1 <> :: Bundle -> Bundle -> Bundle
<> Bundle Components -> (Set ComponentID, Components, DynamicBundle)
b2 = (Components -> (Set ComponentID, Components, DynamicBundle))
-> Bundle
Bundle ((Components -> (Set ComponentID, Components, DynamicBundle))
 -> Bundle)
-> (Components -> (Set ComponentID, Components, DynamicBundle))
-> Bundle
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let (Set ComponentID
cIds1, Components
cs', DynamicBundle
d1) = Components -> (Set ComponentID, Components, DynamicBundle)
b1 Components
cs
        (Set ComponentID
cIds2, Components
cs'', DynamicBundle
d2) = Components -> (Set ComponentID, Components, DynamicBundle)
b2 Components
cs'
     in (Set ComponentID
cIds1 Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Set ComponentID
cIds2, Components
cs'', DynamicBundle
d1 DynamicBundle -> DynamicBundle -> DynamicBundle
forall a. Semigroup a => a -> a -> a
<> DynamicBundle
d2)

-- | @since 0.11

bundle :: forall a. (Component a) => a -> Bundle
bundle :: forall a. Component a => a -> Bundle
bundle a
a = (Components -> (Set ComponentID, Components, DynamicBundle))
-> Bundle
Bundle ((Components -> (Set ComponentID, Components, DynamicBundle))
 -> Bundle)
-> (Components -> (Set ComponentID, Components, DynamicBundle))
-> Bundle
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let (ComponentID
cId, Components
cs') = forall a. Component a => Components -> (ComponentID, Components)
CS.insert @a Components
cs in (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId, Components
cs', ComponentID -> a -> DynamicBundle
forall a. Component a => ComponentID -> a -> DynamicBundle
dynBundle ComponentID
cId a
a)

fromDynBundle :: DynamicBundle -> Bundle
fromDynBundle :: DynamicBundle -> Bundle
fromDynBundle DynamicBundle
d = (Components -> (Set ComponentID, Components, DynamicBundle))
-> Bundle
Bundle (Set ComponentID
forall a. Set a
Set.empty,,DynamicBundle
d)

-- | Insert a bundle of components into an archetype.

--

-- @since 0.9

runBundle :: Bundle -> Components -> EntityID -> Archetype -> (Components, Archetype)
runBundle :: Bundle
-> Components -> EntityID -> Archetype -> (Components, Archetype)
runBundle Bundle
b Components
cs EntityID
eId Archetype
arch =
  let !(Set ComponentID
_, Components
cs', DynamicBundle
d) = Bundle
-> Components -> (Set ComponentID, Components, DynamicBundle)
unBundle Bundle
b Components
cs
      !arch' :: Archetype
arch' = DynamicBundle -> EntityID -> Archetype -> Archetype
runDynamicBundle DynamicBundle
d EntityID
eId Archetype
arch
   in (Components
cs', Archetype
arch')