{-# LANGUAGE FunctionalDependencies #-}

-- |
-- Module      : Aztecs.ECS.Query.Dynamic.Class
-- 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.Query.Dynamic.Class (DynamicQueryF (..)) where

import Aztecs.ECS.Component
import Control.Monad

-- | Dynamic query functor.
--
-- @since 0.10
class (Applicative m, Functor f) => DynamicQueryF m f | f -> m where
  -- | Adjust a `Component` by its `ComponentID`.
  --
  -- @since 0.10
  adjustDyn :: (Component a) => (b -> a -> a) -> ComponentID -> f b -> f a

  -- | Adjust a `Component` by its `ComponentID`, ignoring any output.
  --
  -- @since 0.10
  adjustDyn_ :: (Component a) => (b -> a -> a) -> ComponentID -> f b -> f ()
  adjustDyn_ b -> a -> a
f ComponentID
cId = f a -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f a -> f ()) -> (f b -> f a) -> f b -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a -> a) -> ComponentID -> f b -> f a
forall a b.
Component a =>
(b -> a -> a) -> ComponentID -> f b -> f a
forall (m :: * -> *) (f :: * -> *) a b.
(DynamicQueryF m f, Component a) =>
(b -> a -> a) -> ComponentID -> f b -> f a
adjustDyn b -> a -> a
f ComponentID
cId

  -- | Adjust a `Component` by its `ComponentID` with some applicative functor @g@.
  --
  -- @since 0.10
  adjustDynM :: (Monad m, Component a) => (b -> a -> m a) -> ComponentID -> f b -> f a

  -- | Set a `Component` by its `ComponentID`.
  --
  -- @since 0.10
  setDyn :: (Component a) => ComponentID -> f a -> f a