Tags.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Apecs.Tags where

import Apecs.Core (Entity (..), SystemT)
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import qualified Data.Set as S

{- | The type of tags for a world, e.g. @WTag MyWorld = MyWorldTag@.
  Standalone so that multiple @HasTags w m@ instances share one equation.
-}
type family WTag w

{- | @HasTags w m@ means that world @w@ has a tag system generated by @makeTaggedComponents@.
  Provides a way to query component tags for entities, dispatching on the world type @w@.
-}
class (Monad m) => HasTags w m where
  entityTags :: Entity -> SystemT w m [WTag w]

{- | Count entities grouped by their distinct component combination.

Takes the world's entity member set and uses 'entityTags' from the
'HasTags' class to query each entity's tags. Returns a map from tag sets
to entity counts.
-}
countCombinations
  :: (HasTags w m, Enum (WTag w), Ord (WTag w))
  => IS.IntSet
  -- ^ Entity IDs to census
  -> SystemT w m (M.Map (S.Set (WTag w)) Int)
countCombinations entities = do
  tagSets <- mapM poll (IS.toList entities)
  let counts = M.fromListWith (+) [(ts, 1 :: Int) | ts <- tagSets]
  pure $ M.mapKeysMonotonic (S.fromList . map toEnum . IS.toList) counts
  where
    poll eid = do
      tags <- entityTags (Entity eid)
      pure $! IS.fromList (map fromEnum tags)