{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Aztecs.ECS.Component where

import Aztecs.ECS.Class
import Data.Kind

-- | Component lifecycle hooks.

data Hooks m = Hooks
  { -- | Hook called when a component is inserted.

    forall (m :: * -> *). Hooks m -> Entity m -> m ()
onInsert :: Entity m -> m (),
    -- | Hook called when a component is removed.

    forall (m :: * -> *). Hooks m -> Entity m -> m ()
onRemove :: Entity m -> m ()
  }

instance (Monad m) => Semigroup (Hooks m) where
  Hooks m
h1 <> :: Hooks m -> Hooks m -> Hooks m
<> Hooks m
h2 =
    Hooks
      { onInsert :: Entity m -> m ()
onInsert = \Entity m
e -> Hooks m -> Entity m -> m ()
forall (m :: * -> *). Hooks m -> Entity m -> m ()
onInsert Hooks m
h1 Entity m
e m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Hooks m -> Entity m -> m ()
forall (m :: * -> *). Hooks m -> Entity m -> m ()
onInsert Hooks m
h2 Entity m
e,
        onRemove :: Entity m -> m ()
onRemove = \Entity m
e -> Hooks m -> Entity m -> m ()
forall (m :: * -> *). Hooks m -> Entity m -> m ()
onRemove Hooks m
h1 Entity m
e m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Hooks m -> Entity m -> m ()
forall (m :: * -> *). Hooks m -> Entity m -> m ()
onRemove Hooks m
h2 Entity m
e
      }

instance (Monad m) => Monoid (Hooks m) where
  mempty :: Hooks m
mempty =
    Hooks
      { onInsert :: Entity m -> m ()
onInsert = \Entity m
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
        onRemove :: Entity m -> m ()
onRemove = \Entity m
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      }

class (Monad m) => Component m a where
  type ComponentStorage (m :: Type -> Type) a :: Type -> Type

  -- | Component lifecycle `Hooks`.

  componentHooks :: proxy a -> Hooks m
  componentHooks proxy a
_ = Hooks m
forall a. Monoid a => a
mempty