{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.Components.Required (require, requireAll, toBundleElement) where

import Data.Data
import Data.Default
import Data.Set (Set)
import Data.Set qualified as Set
import Mischief.ECS.Components

class RequiredBundle b where
  defaultBundleData :: Proxy b -> Set DefaultComponentType

instance RequiredBundle () where
  defaultBundleData :: Proxy () -> Set DefaultComponentType
  defaultBundleData :: Proxy () -> Set DefaultComponentType
defaultBundleData Proxy ()
_ = Set DefaultComponentType
forall a. Set a
Set.empty

instance {-# OVERLAPPABLE #-} (Component c, Default c) => RequiredBundle c where
  defaultBundleData :: Proxy c -> Set DefaultComponentType
  defaultBundleData :: Proxy c -> Set DefaultComponentType
defaultBundleData Proxy c
_ = DefaultComponentType -> Set DefaultComponentType
forall a. a -> Set a
Set.singleton (DefaultComponentType -> Set DefaultComponentType)
-> DefaultComponentType -> Set DefaultComponentType
forall a b. (a -> b) -> a -> b
$ Proxy c -> DefaultComponentType
forall c.
(Component c, Default c) =>
Proxy c -> DefaultComponentType
DefaultComponentType (Proxy c -> DefaultComponentType)
-> Proxy c -> DefaultComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c

instance {-# OVERLAPPING #-} (RequiredBundle b0, RequiredBundle b1) => RequiredBundle (b0, b1) where
  defaultBundleData :: Proxy (b0, b1) -> Set DefaultComponentType
defaultBundleData Proxy (b0, b1)
_ =
    let b0 :: Set DefaultComponentType
b0 = Proxy b0 -> Set DefaultComponentType
forall {k} (b :: k).
RequiredBundle b =>
Proxy b -> Set DefaultComponentType
defaultBundleData (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b0)
        b1 :: Set DefaultComponentType
b1 = Proxy b1 -> Set DefaultComponentType
forall {k} (b :: k).
RequiredBundle b =>
Proxy b -> Set DefaultComponentType
defaultBundleData (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b1)
     in Set DefaultComponentType
-> Set DefaultComponentType -> Set DefaultComponentType
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set DefaultComponentType
b0 Set DefaultComponentType
b1

require :: forall b. (RequiredBundle b) => Set DefaultComponentType
require :: forall {k} (b :: k). RequiredBundle b => Set DefaultComponentType
require = Proxy b -> Set DefaultComponentType
forall {k} (b :: k).
RequiredBundle b =>
Proxy b -> Set DefaultComponentType
defaultBundleData (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

requireAll :: forall c. (Component c) => Set DefaultComponentType
requireAll :: forall c. Component c => Set DefaultComponentType
requireAll = Set DefaultComponentType -> Set DefaultComponentType
requireAll' (Set DefaultComponentType -> Set DefaultComponentType)
-> Set DefaultComponentType -> Set DefaultComponentType
forall a b. (a -> b) -> a -> b
$ forall c. Component c => Set DefaultComponentType
required @c

requireAll' :: Set DefaultComponentType -> Set DefaultComponentType
requireAll' :: Set DefaultComponentType -> Set DefaultComponentType
requireAll' Set DefaultComponentType
set =
  let nextSet :: Set DefaultComponentType
nextSet = Set DefaultComponentType -> Set DefaultComponentType
expandAll Set DefaultComponentType
set
   in if Set DefaultComponentType -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set DefaultComponentType
nextSet then Set DefaultComponentType
set else Set DefaultComponentType -> Set DefaultComponentType
requireAll' (Set DefaultComponentType -> Set DefaultComponentType)
-> Set DefaultComponentType -> Set DefaultComponentType
forall a b. (a -> b) -> a -> b
$ Set DefaultComponentType
-> Set DefaultComponentType -> Set DefaultComponentType
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set DefaultComponentType
set Set DefaultComponentType
nextSet

expandAll :: Set DefaultComponentType -> Set DefaultComponentType
expandAll :: Set DefaultComponentType -> Set DefaultComponentType
expandAll Set DefaultComponentType
set =
  let newSet :: Set DefaultComponentType
newSet = [Set DefaultComponentType] -> Set DefaultComponentType
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set DefaultComponentType] -> Set DefaultComponentType)
-> [Set DefaultComponentType] -> Set DefaultComponentType
forall a b. (a -> b) -> a -> b
$ (DefaultComponentType -> Set DefaultComponentType)
-> [DefaultComponentType] -> [Set DefaultComponentType]
forall a b. (a -> b) -> [a] -> [b]
map DefaultComponentType -> Set DefaultComponentType
expandOne (Set DefaultComponentType -> [DefaultComponentType]
forall a. Set a -> [a]
Set.toList Set DefaultComponentType
set)
   in Set DefaultComponentType
-> Set DefaultComponentType -> Set DefaultComponentType
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set DefaultComponentType
newSet Set DefaultComponentType
set

expandOne :: DefaultComponentType -> Set DefaultComponentType
expandOne :: DefaultComponentType -> Set DefaultComponentType
expandOne (DefaultComponentType (Proxy c
_ :: (Proxy c))) = forall c. Component c => Set DefaultComponentType
required @c

toBundleElement :: DefaultComponentType -> BundleElement ErasedComponent
toBundleElement :: DefaultComponentType -> BundleElement ErasedComponent
toBundleElement (DefaultComponentType (Proxy c
_ :: (Proxy c))) = ComponentRep -> ErasedComponent -> BundleElement ErasedComponent
forall e. ComponentRep -> e -> BundleElement e
BundleElement (ComponentType -> ComponentRep
ComponentRep (ComponentType -> ComponentRep) -> ComponentType -> ComponentRep
forall a b. (a -> b) -> a -> b
$ Proxy c -> ComponentType
forall c. Component c => Proxy c -> ComponentType
ComponentType (Proxy c -> ComponentType) -> Proxy c -> ComponentType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) (ErasedComponent -> BundleElement ErasedComponent)
-> ErasedComponent -> BundleElement ErasedComponent
forall a b. (a -> b) -> a -> b
$ c -> ErasedComponent
forall c. Component c => c -> ErasedComponent
ErasedComponent (c -> ErasedComponent) -> c -> ErasedComponent
forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def @c