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

module Aztecs.ECS.World.Components
  ( ComponentID (..),
    Components (..),
    empty,
    lookup,
    insert,
    insert',
  )
where

import Aztecs.ECS.Component (Component, ComponentID (..))
import Control.DeepSeq (NFData)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Typeable (Proxy (..), TypeRep, Typeable, typeOf)
import GHC.Generics (Generic)
import Prelude hiding (lookup)

-- | Component ID map.
data Components = Components
  { Components -> Map TypeRep ComponentID
componentIds :: !(Map TypeRep ComponentID),
    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`.
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.
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.
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.
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)
          }
      )