Util.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeFamilies #-}
-- For Data.Semigroup compatibility
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

module Apecs.Util
  ( -- * Utility
    runGC
  , global

    -- * EntityCounter
  , EntityCounter (..)
  , nextEntity
  , newEntity
  , newEntity_
  , nextEntityIO
  , Maybify
  ) where

import Control.Applicative (liftA2)
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
import Data.IORef
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import Data.Monoid
import Data.Semigroup
import qualified Data.Set as S
import System.Mem (performMajorGC)

import Apecs.Core
import Apecs.Stores
import qualified Apecs.Stores.Internal as Stores
import Apecs.System

-- | Convenience entity, for use in places where the entity value does not matter, i.e. a global store.
global :: Entity
global = Entity (-1)

{- | Component used by newEntity to track the number of issued entities.
  Automatically added to any world created with @makeWorld@
-}
newtype EntityCounter = EntityCounter {getCounter :: Sum Int} deriving (Semigroup, Monoid, Eq, Show)

instance Component EntityCounter where
  type Storage EntityCounter = ReadOnly (Global EntityCounter)

{- | Atomically bumps the EntityCounter and yields its value.
  Relatively slower than nextEntity, but unsafeIOToSTM-safe.
-}
{-# INLINE nextEntityIO #-}
nextEntityIO :: (Has w IO EntityCounter) => SystemT w IO Entity
nextEntityIO = do
  Stores.ReadOnly (Stores.Global ecRef) <- getStore
  liftIO $ atomicModifyIORef' ecRef $ \(EntityCounter (Sum c)) ->
    ( EntityCounter (Sum $ c + 1)
    , Entity c
    )

{- | Bumps the EntityCounter and yields its value.

Not thread-safe.
-}
{-# INLINE nextEntity #-}
nextEntity :: (MonadIO m, Get w m EntityCounter) => SystemT w m Entity
nextEntity = do
  EntityCounter n <- get global
  setReadOnly global (EntityCounter $ n + 1)
  return (Entity . getSum $ n)

{- | Writes the given components to a new entity, and yields that entity.
The return value is often ignored.
-}
{-# INLINE newEntity #-}
newEntity
  :: (MonadIO m, Set w m c, Get w m EntityCounter)
  => c -> SystemT w m Entity
newEntity c = do
  ety <- nextEntity
  set ety c
  return ety

{- | Writes the given components to a new entity without yelding the result.
Used mostly for convenience.
-}
{-# INLINE newEntity_ #-}
newEntity_
  :: (MonadIO m, Set world m component, Get world m EntityCounter)
  => component -> SystemT world m ()
newEntity_ component = do
  entity <- nextEntity
  set entity component

-- | Explicitly invoke the garbage collector
runGC :: (MonadIO m) => SystemT w m ()
runGC = liftIO performMajorGC

{- | Wrap tuple elements in Maybe.

This allows to safely `get` component packs generated by @makeInstanceFold mkTupleT@.
-}
type family Maybify t where
  Maybify (Maybe a) = Maybe a
  Maybify () = ()
  Maybify (a, b) =
    (Maybify a, Maybify b)
  Maybify (a, b, c) =
    (Maybify a, Maybify b, Maybify c)
  Maybify (a, b, c, d) =
    (Maybify a, Maybify b, Maybify c, Maybify d)
  Maybify (a, b, c, d, e) =
    (Maybify a, Maybify b, Maybify c, Maybify d, Maybify e)
  Maybify (a, b, c, d, e, f) =
    (Maybify a, Maybify b, Maybify c, Maybify d, Maybify e, Maybify f)
  Maybify (a, b, c, d, e, f, g) =
    (Maybify a, Maybify b, Maybify c, Maybify d, Maybify e, Maybify f, Maybify g)
  Maybify (a, b, c, d, e, f, g, h) =
    (Maybify a, Maybify b, Maybify c, Maybify d, Maybify e, Maybify f, Maybify g, Maybify h)
  Maybify a = Maybe a