{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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
  ( BundleT (..),
    Bundle,
    MonoidDynamicBundle (..),
    bundle,
    bundleUntracked,
    runBundle,
  )
where

import Aztecs.ECS.Access.Internal (Access)
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 Control.Monad.Identity
import Data.Set (Set)
import qualified Data.Set as Set

-- | Bundle of components.
newtype BundleT m = BundleT
  { -- | Unwrap the bundle.
    forall (m :: * -> *).
BundleT m
-> Components -> (Set ComponentID, Components, DynamicBundle m)
unBundle :: Components -> (Set ComponentID, Components, DynamicBundle m)
  }

-- | Pure bundle of components.
type Bundle = BundleT Identity

instance (Monad m) => Monoid (BundleT m) where
  mempty :: BundleT m
mempty = (Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
forall (m :: * -> *).
(Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
BundleT (Set ComponentID
forall a. Set a
Set.empty,,DynamicBundle m
forall a. Monoid a => a
mempty)

instance (Monad m) => Semigroup (BundleT m) where
  BundleT Components -> (Set ComponentID, Components, DynamicBundle m)
b1 <> :: BundleT m -> BundleT m -> BundleT m
<> BundleT Components -> (Set ComponentID, Components, DynamicBundle m)
b2 = (Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
forall (m :: * -> *).
(Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
BundleT ((Components -> (Set ComponentID, Components, DynamicBundle m))
 -> BundleT m)
-> (Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let (Set ComponentID
cIds1, Components
cs', DynamicBundle m
d1) = Components -> (Set ComponentID, Components, DynamicBundle m)
b1 Components
cs
        (Set ComponentID
cIds2, Components
cs'', DynamicBundle m
d2) = Components -> (Set ComponentID, Components, DynamicBundle m)
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 m
d1 DynamicBundle m -> DynamicBundle m -> DynamicBundle m
forall a. Semigroup a => a -> a -> a
<> DynamicBundle m
d2)

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

-- | Create a bundle that inserts without running lifecycle hooks.
bundleUntracked :: forall m a. (Component m a) => a -> BundleT m
bundleUntracked :: forall (m :: * -> *) a. Component m a => a -> BundleT m
bundleUntracked a
a = (Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
forall (m :: * -> *).
(Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
BundleT ((Components -> (Set ComponentID, Components, DynamicBundle m))
 -> BundleT m)
-> (Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let (ComponentID
cId, Components
cs') = forall a (m :: * -> *).
Component m a =>
Components -> (ComponentID, Components)
CS.insert @a @m Components
cs in (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId, Components
cs', forall (m :: * -> *) a c.
(MonoidDynamicBundle m a, Component m c) =>
ComponentID -> c -> a
dynBundleUntracked @m ComponentID
cId a
a)

instance (Monad m) => MonoidDynamicBundle m (BundleT m) where
  dynBundle :: forall c. Component m c => ComponentID -> c -> BundleT m
dynBundle ComponentID
cId c
c = (Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
forall (m :: * -> *).
(Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
BundleT (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId,,forall (m :: * -> *) a c.
(MonoidDynamicBundle m a, Component m c) =>
ComponentID -> c -> a
dynBundle @m ComponentID
cId c
c)
  dynBundleUntracked :: forall c. Component m c => ComponentID -> c -> BundleT m
dynBundleUntracked ComponentID
cId c
c = (Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
forall (m :: * -> *).
(Components -> (Set ComponentID, Components, DynamicBundle m))
-> BundleT m
BundleT (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId,,forall (m :: * -> *) a c.
(MonoidDynamicBundle m a, Component m c) =>
ComponentID -> c -> a
dynBundleUntracked @m ComponentID
cId c
c)

-- | Insert a bundle of components into an archetype.
runBundle :: (Monad m) => BundleT m -> Components -> EntityID -> Archetype m -> (Components, Archetype m, Access m ())
runBundle :: forall (m :: * -> *).
Monad m =>
BundleT m
-> Components
-> EntityID
-> Archetype m
-> (Components, Archetype m, Access m ())
runBundle BundleT m
b Components
cs EntityID
eId Archetype m
arch =
  let !(Set ComponentID
_, Components
cs', DynamicBundle m
d) = BundleT m
-> Components -> (Set ComponentID, Components, DynamicBundle m)
forall (m :: * -> *).
BundleT m
-> Components -> (Set ComponentID, Components, DynamicBundle m)
unBundle BundleT m
b Components
cs
      !(Archetype m
arch', Access m ()
hook) = DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
forall (m :: * -> *).
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
runDynamicBundle DynamicBundle m
d EntityID
eId Archetype m
arch
   in (Components
cs', Archetype m
arch', Access m ()
hook)