{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}

-- |

-- Module      : Aztecs.ECS.Component

-- 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.Component where

import Aztecs.ECS.World.Storage
import Control.DeepSeq
import Data.Typeable
import GHC.Generics

-- | Unique component identifier.

--

-- @since 0.9

newtype ComponentID = ComponentID
  { -- | Unique integer identifier.

    --

    -- @since 0.9

    ComponentID -> Int
unComponentId :: Int
  }
  deriving (ComponentID -> ComponentID -> Bool
(ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> Bool) -> Eq ComponentID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentID -> ComponentID -> Bool
== :: ComponentID -> ComponentID -> Bool
$c/= :: ComponentID -> ComponentID -> Bool
/= :: ComponentID -> ComponentID -> Bool
Eq, Eq ComponentID
Eq ComponentID =>
(ComponentID -> ComponentID -> Ordering)
-> (ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> Bool)
-> (ComponentID -> ComponentID -> ComponentID)
-> (ComponentID -> ComponentID -> ComponentID)
-> Ord ComponentID
ComponentID -> ComponentID -> Bool
ComponentID -> ComponentID -> Ordering
ComponentID -> ComponentID -> ComponentID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ComponentID -> ComponentID -> Ordering
compare :: ComponentID -> ComponentID -> Ordering
$c< :: ComponentID -> ComponentID -> Bool
< :: ComponentID -> ComponentID -> Bool
$c<= :: ComponentID -> ComponentID -> Bool
<= :: ComponentID -> ComponentID -> Bool
$c> :: ComponentID -> ComponentID -> Bool
> :: ComponentID -> ComponentID -> Bool
$c>= :: ComponentID -> ComponentID -> Bool
>= :: ComponentID -> ComponentID -> Bool
$cmax :: ComponentID -> ComponentID -> ComponentID
max :: ComponentID -> ComponentID -> ComponentID
$cmin :: ComponentID -> ComponentID -> ComponentID
min :: ComponentID -> ComponentID -> ComponentID
Ord, Int -> ComponentID -> ShowS
[ComponentID] -> ShowS
ComponentID -> String
(Int -> ComponentID -> ShowS)
-> (ComponentID -> String)
-> ([ComponentID] -> ShowS)
-> Show ComponentID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentID -> ShowS
showsPrec :: Int -> ComponentID -> ShowS
$cshow :: ComponentID -> String
show :: ComponentID -> String
$cshowList :: [ComponentID] -> ShowS
showList :: [ComponentID] -> ShowS
Show, (forall x. ComponentID -> Rep ComponentID x)
-> (forall x. Rep ComponentID x -> ComponentID)
-> Generic ComponentID
forall x. Rep ComponentID x -> ComponentID
forall x. ComponentID -> Rep ComponentID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComponentID -> Rep ComponentID x
from :: forall x. ComponentID -> Rep ComponentID x
$cto :: forall x. Rep ComponentID x -> ComponentID
to :: forall x. Rep ComponentID x -> ComponentID
Generic, ComponentID -> ()
(ComponentID -> ()) -> NFData ComponentID
forall a. (a -> ()) -> NFData a
$crnf :: ComponentID -> ()
rnf :: ComponentID -> ()
NFData)

-- | Component that can be stored in the `World`.

--

-- @since 0.9

class (Typeable a, Storage a (StorageT a)) => Component a where
  -- | `Storage` of this component.

  --

  -- @since 0.9

  type StorageT a

  type StorageT a = [a]