{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |

-- Module      : Aztecs.ECS.World.Components

-- 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.World.Components
  ( ComponentID (..),
    Components (..),
    empty,
    lookup,
    insert,
    insert',
  )
where

import Aztecs.ECS.Component
import Control.DeepSeq
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Typeable
import GHC.Generics
import Prelude hiding (lookup)

-- | Component ID map.

--

-- @since 0.9

data Components = Components
  { -- | Map of component types to identifiers.

    --

    -- @since 0.9

    Components -> Map TypeRep ComponentID
componentIds :: !(Map TypeRep ComponentID),
    -- | Next unique component identifier.

    --

    -- @since 0.9

    Components -> ComponentID
nextComponentId :: !ComponentID
  }
  deriving (Int -> Components -> ShowS
[Components] -> ShowS
Components -> String
(Int -> Components -> ShowS)
-> (Components -> String)
-> ([Components] -> ShowS)
-> Show Components
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Components -> ShowS
showsPrec :: Int -> Components -> ShowS
$cshow :: Components -> String
show :: Components -> String
$cshowList :: [Components] -> ShowS
showList :: [Components] -> ShowS
Show, (forall x. Components -> Rep Components x)
-> (forall x. Rep Components x -> Components) -> Generic Components
forall x. Rep Components x -> Components
forall x. Components -> Rep Components x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Components -> Rep Components x
from :: forall x. Components -> Rep Components x
$cto :: forall x. Rep Components x -> Components
to :: forall x. Rep Components x -> Components
Generic, Components -> ()
(Components -> ()) -> NFData Components
forall a. (a -> ()) -> NFData a
$crnf :: Components -> ()
rnf :: Components -> ()
NFData)

-- | Empty `Components`.

--

-- @since 0.9

empty :: Components
empty :: Components
empty =
  Components
    { componentIds :: Map TypeRep ComponentID
componentIds = Map TypeRep ComponentID
forall a. Monoid a => a
mempty,
      nextComponentId :: ComponentID
nextComponentId = Int -> ComponentID
ComponentID Int
0
    }

-- | Lookup a component ID by type.

--

-- @since 0.9

lookup :: forall a. (Typeable a) => Components -> Maybe ComponentID
lookup :: forall a. Typeable a => Components -> Maybe ComponentID
lookup Components
cs = TypeRep -> Map TypeRep ComponentID -> Maybe ComponentID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Proxy a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) (Components -> Map TypeRep ComponentID
componentIds Components
cs)

-- | Insert a component ID by type, if it does not already exist.

--

-- @since 0.9

insert :: forall a. (Component a) => Components -> (ComponentID, Components)
insert :: forall a. Component a => Components -> (ComponentID, Components)
insert Components
cs = case forall a. Typeable a => Components -> Maybe ComponentID
lookup @a Components
cs of
  Just ComponentID
cId -> (ComponentID
cId, Components
cs)
  Maybe ComponentID
Nothing -> forall a. Component a => Components -> (ComponentID, Components)
insert' @a Components
cs

-- | Insert a component ID by type.

--

-- @since 0.9

insert' :: forall c. (Component c) => Components -> (ComponentID, Components)
insert' :: forall a. Component a => Components -> (ComponentID, Components)
insert' Components
cs =
  let !cId :: ComponentID
cId = Components -> ComponentID
nextComponentId Components
cs
   in ( ComponentID
cId,
        Components
cs
          { componentIds = Map.insert (typeOf (Proxy @c)) cId (componentIds cs),
            nextComponentId = ComponentID (unComponentId cId + 1)
          }
      )