{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Aztecs.ECS.World.Bundle
  ( Bundle (..),
    MonoidBundle (..),
    MonoidDynamicBundle (..),
    runBundle,
  )
where

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

-- | Bundle of components.
newtype Bundle = Bundle {Bundle
-> Components -> (Set ComponentID, Components, DynamicBundle)
unBundle :: Components -> (Set ComponentID, Components, DynamicBundle)}

instance Monoid Bundle where
  mempty :: Bundle
mempty = (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 -> (Set ComponentID
forall a. Set a
Set.empty, Components
cs, DynamicBundle
forall a. Monoid a => a
mempty)

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)

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)

instance MonoidDynamicBundle Bundle where
  dynBundle :: forall c. Component c => ComponentID -> c -> Bundle
dynBundle ComponentID
cId c
c = (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 -> (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId, Components
cs, 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.
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')