{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}

module Apecs.Stores
  ( Map, Cache, Unique,
    Global,
    Cachable,
    ReadOnly, setReadOnly, destroyReadOnly
    -- Register, regLookup
  ) where

import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import           Data.Bits                   (shiftL, (.&.))
import qualified Data.IntMap.Strict          as M
import           Data.IORef
import           Data.Proxy
import           Data.Typeable               (Typeable, typeRep)
import qualified Data.Vector.Mutable         as VM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           GHC.TypeLits

import           Apecs.Core

-- | A map based on 'Data.IntMap.Strict'. O(log(n)) for most operations.
newtype Map c = Map (IORef (M.IntMap c))

type instance Elem (Map c) = c
instance MonadIO m => ExplInit m (Map c) where
  explInit :: m (Map c)
explInit = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall c. IORef (IntMap c) -> Map c
Map forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty

instance (MonadIO m, Typeable c) => ExplGet m (Map c) where
  explExists :: Map c -> Int -> m Bool
explExists (Map IORef (IntMap c)
ref) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Bool
M.member Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (IntMap c)
ref
  explGet :: Map c -> Int -> m (Elem (Map c))
explGet    (Map IORef (IntMap c)
ref) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (IntMap c)
ref) forall a b. (a -> b) -> a -> b
$ \case
    Just c
c -> c
c
    Maybe c
notFound -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
      [ [Char]
"Reading non-existent Map component"
      , forall a. Show a => a -> [Char]
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Maybe c
notFound)
      , [Char]
"for entity"
      , forall a. Show a => a -> [Char]
show Int
ety
      ]
  {-# INLINE explExists #-}
  {-# INLINE explGet #-}

instance MonadIO m => ExplSet m (Map c) where
  {-# INLINE explSet #-}
  explSet :: Map c -> Int -> Elem (Map c) -> m ()
explSet (Map IORef (IntMap c)
ref) Int
ety Elem (Map c)
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$
    forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (IntMap c)
ref (forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
ety Elem (Map c)
x)

instance MonadIO m => ExplDestroy m (Map c) where
  {-# INLINE explDestroy #-}
  explDestroy :: Map c -> Int -> m ()
explDestroy (Map IORef (IntMap c)
ref) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$
    forall a. IORef a -> IO a
readIORef IORef (IntMap c)
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap c)
ref forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> IntMap a
M.delete Int
ety

instance MonadIO m => ExplMembers m (Map c) where
  {-# INLINE explMembers #-}
  explMembers :: Map c -> m (Vector Int)
explMembers (Map IORef (IntMap c)
ref) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a. Unbox a => [a] -> Vector a
U.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [Int]
M.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (IntMap c)
ref

-- | A Unique contains zero or one component.
--   Writing to it overwrites both the previous component and its owner.
--   Its main purpose is to be a 'Map' optimized for when only ever one component inhabits it.
newtype Unique c = Unique (IORef (Maybe (Int, c)))
type instance Elem (Unique c) = c
instance MonadIO m => ExplInit m (Unique c) where
  explInit :: m (Unique c)
explInit = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall c. IORef (Maybe (Int, c)) -> Unique c
Unique forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing

instance (MonadIO m, Typeable c) => ExplGet m (Unique c) where
  {-# INLINE explGet #-}
  explGet :: Unique c -> Int -> m (Elem (Unique c))
explGet (Unique IORef (Maybe (Int, c))
ref) Int
_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IORef a -> IO a
readIORef IORef (Maybe (Int, c))
ref) forall a b. (a -> b) -> a -> b
$ \case
    Just (Int
_, c
c)  -> c
c
    Maybe (Int, c)
notFound -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
      [ [Char]
"Reading non-existent Unique component"
      , forall a. Show a => a -> [Char]
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Maybe (Int, c)
notFound)
      ]

  {-# INLINE explExists #-}
  explExists :: Unique c -> Int -> m Bool
explExists (Unique IORef (Maybe (Int, c))
ref) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((forall a. Eq a => a -> a -> Bool
==Int
ety) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (Maybe (Int, c))
ref

instance MonadIO m => ExplSet m (Unique c) where
  {-# INLINE explSet #-}
  explSet :: Unique c -> Int -> Elem (Unique c) -> m ()
explSet (Unique IORef (Maybe (Int, c))
ref) Int
ety Elem (Unique c)
c = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Int, c))
ref (forall a. a -> Maybe a
Just (Int
ety, Elem (Unique c)
c))

instance MonadIO m => ExplDestroy m (Unique c) where
  {-# INLINE explDestroy #-}
  explDestroy :: Unique c -> Int -> m ()
explDestroy (Unique IORef (Maybe (Int, c))
ref) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe (Int, c))
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Int, c))
ref forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
==Int
ety) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

instance MonadIO m => ExplMembers m (Unique c) where
  {-# INLINE explMembers #-}
  explMembers :: Unique c -> m (Vector Int)
explMembers (Unique IORef (Maybe (Int, c))
ref) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IORef a -> IO a
readIORef IORef (Maybe (Int, c))
ref) forall a b. (a -> b) -> a -> b
$ \case
    Maybe (Int, c)
Nothing -> forall a. Monoid a => a
mempty
    Just (Int
ety, c
_) -> forall a. Unbox a => a -> Vector a
U.singleton Int
ety

-- | A 'Global' contains exactly one component.
--   The initial value is 'mempty' from the component's 'Monoid' instance.
--   Querying a 'Global' at /any/ Entity yields this one component, effectively sharing the component between /all/ entities.
--
--   A Global component can be read with @'get' 0@ or @'get' 1@ or even @'get' undefined@.
--   The convenience entity 'global' is defined as -1, and can be used to make operations on a global more explicit, i.e. 'Time t <- get global'.
--
--   You also can read and write Globals during a 'cmap' over other components.
newtype Global c = Global (IORef c)
type instance Elem (Global c) = c
instance (Monoid c, MonadIO m) => ExplInit m (Global c) where
  {-# INLINE explInit #-}
  explInit :: m (Global c)
explInit = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall c. IORef c -> Global c
Global forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty

instance MonadIO m => ExplGet m (Global c) where
  {-# INLINE explGet #-}
  explGet :: Global c -> Int -> m (Elem (Global c))
explGet (Global IORef c
ref) Int
_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef c
ref
  {-# INLINE explExists #-}
  explExists :: Global c -> Int -> m Bool
explExists Global c
_ Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

instance MonadIO m => ExplSet m (Global c) where
  {-# INLINE explSet #-}
  explSet :: Global c -> Int -> Elem (Global c) -> m ()
explSet (Global IORef c
ref) Int
_ Elem (Global c)
c = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef c
ref Elem (Global c)
c

-- | Class of stores that behave like a regular map, and can therefore safely be cached.
--   This prevents stores like `Unique` and 'Global', which do /not/ behave like simple maps, from being cached.
class Cachable s
instance Cachable (Map s)
instance (KnownNat n, Cachable s) => Cachable (Cache n s)

-- | A cache around another store.
--   Caches store their members in a fixed-size vector, so read/write operations become O(1).
--   Caches can provide huge performance boosts, especially when working with large numbers of components.
--
--   The cache size is given as a type-level argument.
--
--   Note that iterating over a cache is linear in cache size, so sparsely populated caches might /decrease/ performance.
--   In general, the exact size of the cache does not matter as long as it reasonably approximates the number of components present.
--
--   The cache uses entity (-2) internally to represent missing entities.
--   If you manually manipulate Entity values, be careful that you do not use (-2)
--
--   The actual cache is not necessarily the given argument, but the next biggest power of two.
--   This is allows most operations to be expressed as bit masks, for a large potential performance boost.
data Cache (n :: Nat) s =
  Cache Int (UM.IOVector Int) (VM.IOVector (Elem s)) s

cacheMiss :: t
cacheMiss :: forall t. t
cacheMiss = forall a. HasCallStack => [Char] -> a
error [Char]
"Cache miss! If you are seeing this during normal operation, please open a bug report at https://github.com/jonascarpay/apecs"

type instance Elem (Cache n s) = Elem s

instance (MonadIO m, ExplInit m s, KnownNat n, Cachable s) => ExplInit m (Cache n s) where
  {-# INLINE explInit #-}
  explInit :: m (Cache n s)
explInit = do
    let n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @n) :: Int
        size :: Int
size = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<Int
n) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Int
1
        mask :: Int
mask = Int
size forall a. Num a => a -> a -> a
- Int
1
    IOVector Int
tags <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
UM.replicate Int
size (-Int
2)
    MVector RealWorld (Elem s)
cache <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
VM.replicate Int
size forall t. t
cacheMiss
    s
child <- forall (m :: * -> *) s. ExplInit m s => m s
explInit
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (n :: Nat) s.
Int -> IOVector Int -> IOVector (Elem s) -> s -> Cache n s
Cache Int
mask IOVector Int
tags MVector RealWorld (Elem s)
cache s
child)

instance (MonadIO m, ExplGet m s) => ExplGet m (Cache n s) where
  {-# INLINE explGet #-}
  explGet :: Cache n s -> Int -> m (Elem (Cache n s))
explGet (Cache Int
mask IOVector Int
tags IOVector (Elem s)
cache s
s) Int
ety = do
    let index :: Int
index = Int
ety forall a. Bits a => a -> a -> a
.&. Int
mask
    Int
tag <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
UM.unsafeRead IOVector Int
tags Int
index
    if Int
tag forall a. Eq a => a -> a -> Bool
== Int
ety
       then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
VM.unsafeRead IOVector (Elem s)
cache Int
index
       else forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet s
s Int
ety

  {-# INLINE explExists #-}
  explExists :: Cache n s -> Int -> m Bool
explExists (Cache Int
mask IOVector Int
tags IOVector (Elem s)
_ s
s) Int
ety = do
    Int
tag <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
UM.unsafeRead IOVector Int
tags (Int
ety forall a. Bits a => a -> a -> a
.&. Int
mask)
    if Int
tag forall a. Eq a => a -> a -> Bool
== Int
ety then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists s
s Int
ety

instance (MonadIO m, ExplSet m s) => ExplSet m (Cache n s) where
  {-# INLINE explSet #-}
  explSet :: Cache n s -> Int -> Elem (Cache n s) -> m ()
explSet (Cache Int
mask IOVector Int
tags IOVector (Elem s)
cache s
s) Int
ety Elem (Cache n s)
x = do
    let index :: Int
index = Int
ety forall a. Bits a => a -> a -> a
.&. Int
mask
    Int
tag <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
UM.unsafeRead IOVector Int
tags Int
index
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
tag forall a. Eq a => a -> a -> Bool
/= (-Int
2) Bool -> Bool -> Bool
&& Int
tag forall a. Eq a => a -> a -> Bool
/= Int
ety) forall a b. (a -> b) -> a -> b
$ do
      Elem s
cached <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
VM.unsafeRead IOVector (Elem s)
cache Int
index
      forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet s
s Int
tag Elem s
cached
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UM.unsafeWrite IOVector Int
tags  Int
index Int
ety
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.unsafeWrite IOVector (Elem s)
cache Int
index Elem (Cache n s)
x

instance (MonadIO m, ExplDestroy m s) => ExplDestroy m (Cache n s) where
  {-# INLINE explDestroy #-}
  explDestroy :: Cache n s -> Int -> m ()
explDestroy (Cache Int
mask IOVector Int
tags IOVector (Elem s)
cache s
s) Int
ety = do
    let index :: Int
index = Int
ety forall a. Bits a => a -> a -> a
.&. Int
mask
    Int
tag <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
UM.unsafeRead IOVector Int
tags (Int
ety forall a. Bits a => a -> a -> a
.&. Int
mask)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
tag forall a. Eq a => a -> a -> Bool
== Int
ety) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UM.unsafeWrite IOVector Int
tags  Int
index (-Int
2)
      forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.unsafeWrite IOVector (Elem s)
cache Int
index forall t. t
cacheMiss
    forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy s
s Int
ety

instance (MonadIO m, ExplMembers m s) => ExplMembers m (Cache n s) where
  {-# INLINE explMembers #-}
  explMembers :: Cache n s -> m (Vector Int)
explMembers (Cache Int
mask IOVector Int
tags IOVector (Elem s)
_ s
s) = do
    Vector Int
cached <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$ forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
U.filter (forall a. Eq a => a -> a -> Bool
/= (-Int
2)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.freeze IOVector Int
tags
    let etyFilter :: Int -> IO Bool
etyFilter Int
ety = (forall a. Eq a => a -> a -> Bool
/= Int
ety) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
UM.unsafeRead IOVector Int
tags (Int
ety forall a. Bits a => a -> a -> a
.&. Int
mask)
    Vector Int
stored <- forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers s
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(a -> m Bool) -> Vector a -> m (Vector a)
U.filterM Int -> IO Bool
etyFilter
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Vector Int
cached forall a. Unbox a => Vector a -> Vector a -> Vector a
U.++ Vector Int
stored

-- | Wrapper that makes a store read-only by hiding its 'ExplSet' and 'ExplDestroy' instances.
--   This is primarily used to protect the 'EntityCounter' from accidental overwrites.
--   Use 'setReadOnly' and 'destroyReadOnly' to override.
newtype ReadOnly s = ReadOnly s
type instance Elem (ReadOnly s) = Elem s

instance (Functor m, ExplInit m s) => ExplInit m (ReadOnly s) where
  explInit :: m (ReadOnly s)
explInit = forall s. s -> ReadOnly s
ReadOnly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. ExplInit m s => m s
explInit

instance ExplGet m s => ExplGet m (ReadOnly s) where
  explExists :: ReadOnly s -> Int -> m Bool
explExists (ReadOnly s
s) = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists s
s
  explGet :: ReadOnly s -> Int -> m (Elem (ReadOnly s))
explGet    (ReadOnly s
s) = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet s
s
  {-# INLINE explExists #-}
  {-# INLINE explGet #-}

instance ExplMembers m s => ExplMembers m (ReadOnly s) where
  {-# INLINE explMembers #-}
  explMembers :: ReadOnly s -> m (Vector Int)
explMembers (ReadOnly s
s) = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers s
s

setReadOnly :: 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 :: 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 Int
ety) c
c = do
  ReadOnly s
s <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet s
s Int
ety c
c

destroyReadOnly :: forall w m s c.
  ( Has w m c
  , Storage c ~ ReadOnly s
  , Elem s ~ c
  , ExplDestroy m s
  ) => Entity -> Proxy c -> SystemT w m ()
destroyReadOnly :: forall w (m :: * -> *) s c.
(Has w m c, Storage c ~ ReadOnly s, Elem s ~ c, ExplDestroy m s) =>
Entity -> Proxy c -> SystemT w m ()
destroyReadOnly (Entity Int
ety) Proxy c
_ = do
  ReadOnly s
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy s
s Int
ety