{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}

module Aztecs.ECS.Access.Class (MonadAccess (..)) where

import Aztecs.ECS.Component (Component (..))
import Aztecs.ECS.Entity (EntityID (..))
import Aztecs.ECS.World.Bundle (MonoidBundle (..))
import Prelude hiding (all, lookup, map)

-- | Monadic access to a `World`.
class (MonoidBundle b, Monad m) => MonadAccess b m | m -> b where
  -- | Spawn an entity with a component.
  spawn :: b -> m EntityID

  -- | Spawn an entity with a component.
  spawn_ :: b -> m ()
  spawn_ b
c = do
    EntityID
_ <- b -> m EntityID
forall b (m :: * -> *). MonadAccess b m => b -> m EntityID
spawn b
c
    () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- | Insert a component into an entity.
  insert :: (Component a) => EntityID -> a -> m ()

  -- | Lookup a component on an entity.
  lookup :: (Component a) => EntityID -> m (Maybe a)

  -- | Remove a component from an entity.
  remove :: (Component a) => EntityID -> m (Maybe a)

  -- | Despawn an entity.
  despawn :: EntityID -> m ()