{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# 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 (..),
    MonoidBundle (..),
    MonoidDynamicBundle (..),
    runBundle,
  )
where

import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.World.Archetype
import Aztecs.ECS.World.Bundle.Class
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.9
instance MonoidBundle Bundle where
  bundle :: forall a. (Component a) => a -> Bundle
  bundle :: forall c. Component c => c -> 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 c. Component c => ComponentID -> c -> DynamicBundle
forall a c.
(MonoidDynamicBundle a, Component c) =>
ComponentID -> c -> a
dynBundle ComponentID
cId a
a)

-- | @since 0.9
instance MonoidDynamicBundle Bundle where
  dynBundle :: forall c. Component c => ComponentID -> c -> Bundle
dynBundle ComponentID
cId c
c = (Components -> (Set ComponentID, Components, DynamicBundle))
-> Bundle
Bundle (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId,,ComponentID -> c -> DynamicBundle
forall c. Component c => ComponentID -> c -> DynamicBundle
forall a c.
(MonoidDynamicBundle a, Component c) =>
ComponentID -> c -> a
dynBundle ComponentID
cId c
c)

-- | 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')