{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- For Data.Semigroup compatibility

{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE Strict                     #-}
{-# LANGUAGE TypeFamilies               #-}

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

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

import           Control.Applicative  (liftA2)
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import           Data.Monoid
import           Data.Semigroup
import           System.Mem           (performMajorGC)

import           Apecs.Core
import           Apecs.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
global = Int -> Entity
Entity (-Int
1)

-- | Component used by newEntity to track the number of issued entities.
--   Automatically added to any world created with @makeWorld@
newtype EntityCounter = EntityCounter {EntityCounter -> Sum Int
getCounter :: Sum Int} deriving (b -> EntityCounter -> EntityCounter
NonEmpty EntityCounter -> EntityCounter
EntityCounter -> EntityCounter -> EntityCounter
(EntityCounter -> EntityCounter -> EntityCounter)
-> (NonEmpty EntityCounter -> EntityCounter)
-> (forall b. Integral b => b -> EntityCounter -> EntityCounter)
-> Semigroup EntityCounter
forall b. Integral b => b -> EntityCounter -> EntityCounter
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> EntityCounter -> EntityCounter
$cstimes :: forall b. Integral b => b -> EntityCounter -> EntityCounter
sconcat :: NonEmpty EntityCounter -> EntityCounter
$csconcat :: NonEmpty EntityCounter -> EntityCounter
<> :: EntityCounter -> EntityCounter -> EntityCounter
$c<> :: EntityCounter -> EntityCounter -> EntityCounter
Semigroup, Semigroup EntityCounter
EntityCounter
Semigroup EntityCounter
-> EntityCounter
-> (EntityCounter -> EntityCounter -> EntityCounter)
-> ([EntityCounter] -> EntityCounter)
-> Monoid EntityCounter
[EntityCounter] -> EntityCounter
EntityCounter -> EntityCounter -> EntityCounter
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [EntityCounter] -> EntityCounter
$cmconcat :: [EntityCounter] -> EntityCounter
mappend :: EntityCounter -> EntityCounter -> EntityCounter
$cmappend :: EntityCounter -> EntityCounter -> EntityCounter
mempty :: EntityCounter
$cmempty :: EntityCounter
$cp1Monoid :: Semigroup EntityCounter
Monoid, EntityCounter -> EntityCounter -> Bool
(EntityCounter -> EntityCounter -> Bool)
-> (EntityCounter -> EntityCounter -> Bool) -> Eq EntityCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityCounter -> EntityCounter -> Bool
$c/= :: EntityCounter -> EntityCounter -> Bool
== :: EntityCounter -> EntityCounter -> Bool
$c== :: EntityCounter -> EntityCounter -> Bool
Eq, Int -> EntityCounter -> ShowS
[EntityCounter] -> ShowS
EntityCounter -> String
(Int -> EntityCounter -> ShowS)
-> (EntityCounter -> String)
-> ([EntityCounter] -> ShowS)
-> Show EntityCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityCounter] -> ShowS
$cshowList :: [EntityCounter] -> ShowS
show :: EntityCounter -> String
$cshow :: EntityCounter -> String
showsPrec :: Int -> EntityCounter -> ShowS
$cshowsPrec :: Int -> EntityCounter -> ShowS
Show)

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

-- | Bumps the EntityCounter and yields its value
{-# INLINE nextEntity #-}
nextEntity :: (MonadIO m, Get w m EntityCounter) => SystemT w m Entity
nextEntity :: SystemT w m Entity
nextEntity = do EntityCounter Sum Int
n <- Entity -> SystemT w m EntityCounter
forall w (m :: * -> *) c. Get w m c => Entity -> SystemT w m c
get Entity
global
                Entity -> EntityCounter -> SystemT w m ()
forall w (m :: * -> *) s c.
(Has w m c, Storage c ~ ReadOnly s, Elem s ~ c, ExplSet m s) =>
Entity -> c -> SystemT w m ()
setReadOnly Entity
global (Sum Int -> EntityCounter
EntityCounter (Sum Int -> EntityCounter) -> Sum Int -> EntityCounter
forall a b. (a -> b) -> a -> b
$ Sum Int
nSum Int -> Sum Int -> Sum Int
forall a. Num a => a -> a -> a
+Sum Int
1)
                Entity -> SystemT w m Entity
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Entity
Entity (Int -> Entity) -> (Sum Int -> Int) -> Sum Int -> Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Entity) -> Sum Int -> Entity
forall a b. (a -> b) -> a -> b
$ Sum Int
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 -> SystemT w m Entity
newEntity c
c = do Entity
ety <- SystemT w m Entity
forall (m :: * -> *) w.
(MonadIO m, Get w m EntityCounter) =>
SystemT w m Entity
nextEntity
                 Entity -> c -> SystemT w m ()
forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
set Entity
ety c
c
                 Entity -> SystemT w m Entity
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
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 -> SystemT world m ()
newEntity_ component
component = do
  Entity
entity <- SystemT world m Entity
forall (m :: * -> *) w.
(MonadIO m, Get w m EntityCounter) =>
SystemT w m Entity
nextEntity
  Entity -> component -> SystemT world m ()
forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
set Entity
entity component
component

-- | Explicitly invoke the garbage collector
runGC :: System w ()
runGC :: System w ()
runGC = IO () -> System w ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ()
performMajorGC