{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Trustworthy #-}

-- |
-- Module      :  Games.ECS.Component.Store
-- Description : Collection types for components.
-- Copyright   :  (C) 2020 Sophie Taylor
-- License     :  AGPL-3.0-or-later
-- Maintainer  :  Sophie Taylor <sophie@spacekitteh.moe>
-- Stability   :  experimental
-- Portability: GHC
--
-- Different components, when stored in bulk, may be suited to different collection types.
module Games.ECS.Component.Store
  ( EntityIndexedTraversable (..),
    InternedComponentStore,
    ComponentStore,
    EntitySet,
    theKeys,
    theMap,
    theInternedMap,
    IntersectionOfEntities,
  )
where

import Control.Lens
import Data.Hashable
import Data.IntMap.Strict qualified as IM
import Data.IntSet qualified as IS
import Data.Interned
import GHC.Generics (Generic, Generic1)
import Games.ECS.Entity

-- | A class for types which contain objects which are indexed by an 'Entity'.
class EntityIndexedTraversable t c where -- TODO make this kind polymorphic

  -- | Traverse the collection.
  entitiesTraversed :: IndexedTraversal' Entity (t c) c
  default entitiesTraversed :: (TraversableWithIndex Entity t) => IndexedTraversal' Entity (t c) c
  entitiesTraversed = p c (f c) -> t c -> f (t c)
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
IndexedTraversal' Entity (t c) c
itraversed
  {-# INLINE entitiesTraversed #-}

-- | An 'IS.IntMap'-based 'Games.ECS.Component.Component' store
data ComponentStore c = ComponentStore {forall c. ComponentStore c -> IntMap c
_theMap :: IM.IntMap c, forall c. ComponentStore c -> EntitySet
_theKeys :: EntitySet} deriving (ComponentStore c -> ComponentStore c -> Bool
(ComponentStore c -> ComponentStore c -> Bool)
-> (ComponentStore c -> ComponentStore c -> Bool)
-> Eq (ComponentStore c)
forall c. Eq c => ComponentStore c -> ComponentStore c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => ComponentStore c -> ComponentStore c -> Bool
== :: ComponentStore c -> ComponentStore c -> Bool
$c/= :: forall c. Eq c => ComponentStore c -> ComponentStore c -> Bool
/= :: ComponentStore c -> ComponentStore c -> Bool
Eq, Int -> ComponentStore c -> ShowS
[ComponentStore c] -> ShowS
ComponentStore c -> String
(Int -> ComponentStore c -> ShowS)
-> (ComponentStore c -> String)
-> ([ComponentStore c] -> ShowS)
-> Show (ComponentStore c)
forall c. Show c => Int -> ComponentStore c -> ShowS
forall c. Show c => [ComponentStore c] -> ShowS
forall c. Show c => ComponentStore c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> ComponentStore c -> ShowS
showsPrec :: Int -> ComponentStore c -> ShowS
$cshow :: forall c. Show c => ComponentStore c -> String
show :: ComponentStore c -> String
$cshowList :: forall c. Show c => [ComponentStore c] -> ShowS
showList :: [ComponentStore c] -> ShowS
Show, (forall a b. (a -> b) -> ComponentStore a -> ComponentStore b)
-> (forall a b. a -> ComponentStore b -> ComponentStore a)
-> Functor ComponentStore
forall a b. a -> ComponentStore b -> ComponentStore a
forall a b. (a -> b) -> ComponentStore a -> ComponentStore b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ComponentStore a -> ComponentStore b
fmap :: forall a b. (a -> b) -> ComponentStore a -> ComponentStore b
$c<$ :: forall a b. a -> ComponentStore b -> ComponentStore a
<$ :: forall a b. a -> ComponentStore b -> ComponentStore a
Functor, (forall a. ComponentStore a -> Rep1 ComponentStore a)
-> (forall a. Rep1 ComponentStore a -> ComponentStore a)
-> Generic1 ComponentStore
forall a. Rep1 ComponentStore a -> ComponentStore a
forall a. ComponentStore a -> Rep1 ComponentStore a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. ComponentStore a -> Rep1 ComponentStore a
from1 :: forall a. ComponentStore a -> Rep1 ComponentStore a
$cto1 :: forall a. Rep1 ComponentStore a -> ComponentStore a
to1 :: forall a. Rep1 ComponentStore a -> ComponentStore a
Generic1, (forall m. Monoid m => ComponentStore m -> m)
-> (forall m a. Monoid m => (a -> m) -> ComponentStore a -> m)
-> (forall m a. Monoid m => (a -> m) -> ComponentStore a -> m)
-> (forall a b. (a -> b -> b) -> b -> ComponentStore a -> b)
-> (forall a b. (a -> b -> b) -> b -> ComponentStore a -> b)
-> (forall b a. (b -> a -> b) -> b -> ComponentStore a -> b)
-> (forall b a. (b -> a -> b) -> b -> ComponentStore a -> b)
-> (forall a. (a -> a -> a) -> ComponentStore a -> a)
-> (forall a. (a -> a -> a) -> ComponentStore a -> a)
-> (forall a. ComponentStore a -> [a])
-> (forall a. ComponentStore a -> Bool)
-> (forall a. ComponentStore a -> Int)
-> (forall a. Eq a => a -> ComponentStore a -> Bool)
-> (forall a. Ord a => ComponentStore a -> a)
-> (forall a. Ord a => ComponentStore a -> a)
-> (forall a. Num a => ComponentStore a -> a)
-> (forall a. Num a => ComponentStore a -> a)
-> Foldable ComponentStore
forall a. Eq a => a -> ComponentStore a -> Bool
forall a. Num a => ComponentStore a -> a
forall a. Ord a => ComponentStore a -> a
forall m. Monoid m => ComponentStore m -> m
forall a. ComponentStore a -> Bool
forall a. ComponentStore a -> Int
forall a. ComponentStore a -> [a]
forall a. (a -> a -> a) -> ComponentStore a -> a
forall m a. Monoid m => (a -> m) -> ComponentStore a -> m
forall b a. (b -> a -> b) -> b -> ComponentStore a -> b
forall a b. (a -> b -> b) -> b -> ComponentStore a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ComponentStore m -> m
fold :: forall m. Monoid m => ComponentStore m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ComponentStore a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ComponentStore a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ComponentStore a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ComponentStore a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ComponentStore a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ComponentStore a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ComponentStore a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ComponentStore a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ComponentStore a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ComponentStore a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ComponentStore a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ComponentStore a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ComponentStore a -> a
foldr1 :: forall a. (a -> a -> a) -> ComponentStore a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ComponentStore a -> a
foldl1 :: forall a. (a -> a -> a) -> ComponentStore a -> a
$ctoList :: forall a. ComponentStore a -> [a]
toList :: forall a. ComponentStore a -> [a]
$cnull :: forall a. ComponentStore a -> Bool
null :: forall a. ComponentStore a -> Bool
$clength :: forall a. ComponentStore a -> Int
length :: forall a. ComponentStore a -> Int
$celem :: forall a. Eq a => a -> ComponentStore a -> Bool
elem :: forall a. Eq a => a -> ComponentStore a -> Bool
$cmaximum :: forall a. Ord a => ComponentStore a -> a
maximum :: forall a. Ord a => ComponentStore a -> a
$cminimum :: forall a. Ord a => ComponentStore a -> a
minimum :: forall a. Ord a => ComponentStore a -> a
$csum :: forall a. Num a => ComponentStore a -> a
sum :: forall a. Num a => ComponentStore a -> a
$cproduct :: forall a. Num a => ComponentStore a -> a
product :: forall a. Num a => ComponentStore a -> a
Foldable, Functor ComponentStore
Foldable ComponentStore
(Functor ComponentStore, Foldable ComponentStore) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ComponentStore a -> f (ComponentStore b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ComponentStore (f a) -> f (ComponentStore a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ComponentStore a -> m (ComponentStore b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ComponentStore (m a) -> m (ComponentStore a))
-> Traversable ComponentStore
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ComponentStore (m a) -> m (ComponentStore a)
forall (f :: * -> *) a.
Applicative f =>
ComponentStore (f a) -> f (ComponentStore a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ComponentStore a -> m (ComponentStore b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ComponentStore a -> f (ComponentStore b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ComponentStore a -> f (ComponentStore b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ComponentStore a -> f (ComponentStore b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ComponentStore (f a) -> f (ComponentStore a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ComponentStore (f a) -> f (ComponentStore a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ComponentStore a -> m (ComponentStore b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ComponentStore a -> m (ComponentStore b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ComponentStore (m a) -> m (ComponentStore a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ComponentStore (m a) -> m (ComponentStore a)
Traversable, (forall x. ComponentStore c -> Rep (ComponentStore c) x)
-> (forall x. Rep (ComponentStore c) x -> ComponentStore c)
-> Generic (ComponentStore c)
forall x. Rep (ComponentStore c) x -> ComponentStore c
forall x. ComponentStore c -> Rep (ComponentStore c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (ComponentStore c) x -> ComponentStore c
forall c x. ComponentStore c -> Rep (ComponentStore c) x
$cfrom :: forall c x. ComponentStore c -> Rep (ComponentStore c) x
from :: forall x. ComponentStore c -> Rep (ComponentStore c) x
$cto :: forall c x. Rep (ComponentStore c) x -> ComponentStore c
to :: forall x. Rep (ComponentStore c) x -> ComponentStore c
Generic)

-- deriving instance Generic (ComponentStore c)
instance FunctorWithIndex Entity (ComponentStore) where
  {-# INLINE imap #-}
  imap :: forall a b.
(Entity -> a -> b) -> ComponentStore a -> ComponentStore b
imap Entity -> a -> b
f (ComponentStore IntMap a
s EntitySet
ks) = IntMap b -> EntitySet -> ComponentStore b
forall c. IntMap c -> EntitySet -> ComponentStore c
ComponentStore ((Int -> a -> b) -> IntMap a -> IntMap b
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (Entity -> a -> b
f (Entity -> a -> b) -> (Int -> Entity) -> Int -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Entity
EntRef) IntMap a
s) EntitySet
ks

instance EntityIndexedTraversable ComponentStore c

instance FoldableWithIndex Entity ComponentStore where
  {-# INLINE ifoldMap #-}
  {-# INLINE ifoldr #-}
  {-# INLINE ifoldl' #-}
  ifoldMap :: forall m a. Monoid m => (Entity -> a -> m) -> ComponentStore a -> m
ifoldMap Entity -> a -> m
f (ComponentStore IntMap a
s EntitySet
_) = (Int -> a -> m) -> IntMap a -> m
forall m a. Monoid m => (Int -> a -> m) -> IntMap a -> m
IM.foldMapWithKey (Entity -> a -> m
f (Entity -> a -> m) -> (Int -> Entity) -> Int -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Entity
EntRef) IntMap a
s
  ifoldr :: forall a b. (Entity -> a -> b -> b) -> b -> ComponentStore a -> b
ifoldr Entity -> a -> b -> b
f b
b (ComponentStore IntMap a
s EntitySet
_) = (Int -> a -> b -> b) -> b -> IntMap a -> b
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IM.foldrWithKey (Entity -> a -> b -> b
f (Entity -> a -> b -> b) -> (Int -> Entity) -> Int -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Entity
EntRef) b
b IntMap a
s
  ifoldl' :: forall b a. (Entity -> b -> a -> b) -> b -> ComponentStore a -> b
ifoldl' Entity -> b -> a -> b
f b
b (ComponentStore IntMap a
s EntitySet
_) = (b -> Int -> a -> b) -> b -> IntMap a -> b
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IM.foldlWithKey' ((Int -> b -> a -> b) -> b -> Int -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Entity -> b -> a -> b
f (Entity -> b -> a -> b) -> (Int -> Entity) -> Int -> b -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Entity
EntRef)) b
b IntMap a
s

instance TraversableWithIndex Entity ComponentStore where
  {-# INLINE itraverse #-}
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Entity -> a -> f b) -> ComponentStore a -> f (ComponentStore b)
itraverse Entity -> a -> f b
f (ComponentStore IntMap a
s EntitySet
ks) = (IntMap b -> ComponentStore b)
-> f (IntMap b) -> f (ComponentStore b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IntMap b
i -> IntMap b -> EntitySet -> ComponentStore b
forall c. IntMap c -> EntitySet -> ComponentStore c
ComponentStore IntMap b
i EntitySet
ks) (f (IntMap b) -> f (ComponentStore b))
-> f (IntMap b) -> f (ComponentStore b)
forall a b. (a -> b) -> a -> b
$ (Int -> a -> f b) -> IntMap a -> f (IntMap b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> IntMap a -> f (IntMap b)
itraverse (Entity -> a -> f b
f (Entity -> a -> f b) -> (Int -> Entity) -> Int -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Entity
EntRef) IntMap a
s

type instance Index (ComponentStore c) = Entity

type instance IxValue (ComponentStore c) = c

instance At (ComponentStore c) where
  {-# INLINE at #-}
  at :: Index (ComponentStore c)
-> Lens' (ComponentStore c) (Maybe (IxValue (ComponentStore c)))
at (EntRef Int
k) Maybe (IxValue (ComponentStore c))
-> f (Maybe (IxValue (ComponentStore c)))
f cs :: ComponentStore c
cs@(ComponentStore IntMap c
s (EntitySet IntSet
ks)) =
    Maybe (IxValue (ComponentStore c))
-> f (Maybe (IxValue (ComponentStore c)))
f Maybe c
Maybe (IxValue (ComponentStore c))
mv f (Maybe c)
-> (Maybe c -> ComponentStore c) -> f (ComponentStore c)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe c
r -> case Maybe c
r of
      Maybe c
Nothing -> ComponentStore c
-> (c -> ComponentStore c) -> Maybe c -> ComponentStore c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ComponentStore c
cs (ComponentStore c -> c -> ComponentStore c
forall a b. a -> b -> a
const (IntMap c -> EntitySet -> ComponentStore c
forall c. IntMap c -> EntitySet -> ComponentStore c
ComponentStore (Int -> IntMap c -> IntMap c
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
k IntMap c
s) (IntSet -> EntitySet
EntitySet (Int -> IntSet -> IntSet
IS.delete Int
k IntSet
ks)))) Maybe c
mv
      Just c
v' -> IntMap c -> EntitySet -> ComponentStore c
forall c. IntMap c -> EntitySet -> ComponentStore c
ComponentStore (Int -> c -> IntMap c -> IntMap c
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
k c
v' IntMap c
s) (IntSet -> EntitySet
EntitySet (Int -> IntSet -> IntSet
IS.insert Int
k IntSet
ks))
    where
      mv :: Maybe c
mv = Int -> IntMap c -> Maybe c
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k IntMap c
s

instance Ixed (ComponentStore c) where
  {-# INLINE ix #-}
  ix :: Index (ComponentStore c)
-> Traversal' (ComponentStore c) (IxValue (ComponentStore c))
ix (EntRef Int
k) IxValue (ComponentStore c) -> f (IxValue (ComponentStore c))
f (ComponentStore IntMap c
s EntitySet
ks) = (IntMap c -> ComponentStore c)
-> f (IntMap c) -> f (ComponentStore c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IntMap c
i -> IntMap c -> EntitySet -> ComponentStore c
forall c. IntMap c -> EntitySet -> ComponentStore c
ComponentStore IntMap c
i EntitySet
ks) (f (IntMap c) -> f (ComponentStore c))
-> f (IntMap c) -> f (ComponentStore c)
forall a b. (a -> b) -> a -> b
$ Index (IntMap c) -> Traversal' (IntMap c) (IxValue (IntMap c))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (IntMap c)
k IxValue (IntMap c) -> f (IxValue (IntMap c))
IxValue (ComponentStore c) -> f (IxValue (ComponentStore c))
f IntMap c
s

instance AsEmpty (ComponentStore c) where
  {-# INLINE _Empty #-}
  _Empty :: Prism' (ComponentStore c) ()
_Empty = ComponentStore c
-> (ComponentStore c -> Bool) -> Prism' (ComponentStore c) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly (IntMap c -> EntitySet -> ComponentStore c
forall c. IntMap c -> EntitySet -> ComponentStore c
ComponentStore IntMap c
forall a. IntMap a
IM.empty (IntSet -> EntitySet
EntitySet IntSet
IS.empty)) (\(ComponentStore IntMap c
_ (EntitySet IntSet
ks)) -> IntSet -> Bool
IS.null IntSet
ks)

makeLenses ''ComponentStore

instance HasEntitySet (ComponentStore c) where
  {-# INLINE entitySet #-}
  entitySet :: Fold (ComponentStore c) EntitySet
entitySet = (EntitySet -> f EntitySet)
-> ComponentStore c -> f (ComponentStore c)
forall c (f :: * -> *).
Functor f =>
(EntitySet -> f EntitySet)
-> ComponentStore c -> f (ComponentStore c)
theKeys

data InternedComponent c = InternedComponent {forall c. InternedComponent c -> Int
_internedId :: Id, forall c. InternedComponent c -> c
_internedValue :: c} deriving ((forall x. InternedComponent c -> Rep (InternedComponent c) x)
-> (forall x. Rep (InternedComponent c) x -> InternedComponent c)
-> Generic (InternedComponent c)
forall x. Rep (InternedComponent c) x -> InternedComponent c
forall x. InternedComponent c -> Rep (InternedComponent c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (InternedComponent c) x -> InternedComponent c
forall c x. InternedComponent c -> Rep (InternedComponent c) x
$cfrom :: forall c x. InternedComponent c -> Rep (InternedComponent c) x
from :: forall x. InternedComponent c -> Rep (InternedComponent c) x
$cto :: forall c x. Rep (InternedComponent c) x -> InternedComponent c
to :: forall x. Rep (InternedComponent c) x -> InternedComponent c
Generic, Int -> InternedComponent c -> ShowS
[InternedComponent c] -> ShowS
InternedComponent c -> String
(Int -> InternedComponent c -> ShowS)
-> (InternedComponent c -> String)
-> ([InternedComponent c] -> ShowS)
-> Show (InternedComponent c)
forall c. Show c => Int -> InternedComponent c -> ShowS
forall c. Show c => [InternedComponent c] -> ShowS
forall c. Show c => InternedComponent c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> InternedComponent c -> ShowS
showsPrec :: Int -> InternedComponent c -> ShowS
$cshow :: forall c. Show c => InternedComponent c -> String
show :: InternedComponent c -> String
$cshowList :: forall c. Show c => [InternedComponent c] -> ShowS
showList :: [InternedComponent c] -> ShowS
Show)

instance Eq (InternedComponent c) where
  {-# INLINE (==) #-}
  InternedComponent Int
a c
_ == :: InternedComponent c -> InternedComponent c -> Bool
== InternedComponent Int
b c
_ = Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b

instance Ord (InternedComponent c) where
  {-# INLINE compare #-}
  compare :: InternedComponent c -> InternedComponent c -> Ordering
compare (InternedComponent Int
a c
_) (InternedComponent Int
b c
_) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
a Int
b

instance Hashable (InternedComponent c) where
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> InternedComponent c -> Int
hashWithSalt Int
s (InternedComponent Int
i c
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Int
i

instance (Hashable c, Eq c) => Interned (InternedComponent c) where
  type Uninterned (InternedComponent c) = c
  newtype Description (InternedComponent c) = DSC c deriving (Description (InternedComponent c)
-> Description (InternedComponent c) -> Bool
(Description (InternedComponent c)
 -> Description (InternedComponent c) -> Bool)
-> (Description (InternedComponent c)
    -> Description (InternedComponent c) -> Bool)
-> Eq (Description (InternedComponent c))
forall c.
Eq c =>
Description (InternedComponent c)
-> Description (InternedComponent c) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c.
Eq c =>
Description (InternedComponent c)
-> Description (InternedComponent c) -> Bool
== :: Description (InternedComponent c)
-> Description (InternedComponent c) -> Bool
$c/= :: forall c.
Eq c =>
Description (InternedComponent c)
-> Description (InternedComponent c) -> Bool
/= :: Description (InternedComponent c)
-> Description (InternedComponent c) -> Bool
Eq)
  {-# INLINE CONLIKE describe #-}
  describe :: Uninterned (InternedComponent c)
-> Description (InternedComponent c)
describe = c -> Description (InternedComponent c)
Uninterned (InternedComponent c)
-> Description (InternedComponent c)
forall c. c -> Description (InternedComponent c)
DSC
  {-# INLINE CONLIKE identify #-}
  identify :: Int -> Uninterned (InternedComponent c) -> InternedComponent c
identify = Int -> c -> InternedComponent c
Int -> Uninterned (InternedComponent c) -> InternedComponent c
forall c. Int -> c -> InternedComponent c
InternedComponent
  {-# INLINE CONLIKE cache #-}
  cache :: Cache (InternedComponent c)
cache = Cache (InternedComponent c)
forall c. (Eq c, Hashable c) => Cache (InternedComponent c)
itCache

itCache :: (Eq c, Hashable c) => Cache (InternedComponent c)
itCache :: forall c. (Eq c, Hashable c) => Cache (InternedComponent c)
itCache = Cache (InternedComponent c)
forall t. Interned t => Cache t
mkCache
{-# NOINLINE itCache #-}

instance (Hashable c) => Hashable (Description (InternedComponent c)) where
  hashWithSalt :: Int -> Description (InternedComponent c) -> Int
hashWithSalt Int
s (DSC c
c) = Int -> c -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s c
c
  {-# INLINE hashWithSalt #-}

instance (Eq c, Hashable c) => Uninternable (InternedComponent c) where
  unintern :: InternedComponent c -> Uninterned (InternedComponent c)
unintern (InternedComponent Int
_ c
c) = c
Uninterned (InternedComponent c)
c
  {-# INLINE unintern #-}

-- | Some components may be shared in common among a large number of entities, and may be expensive to compare for equality. This type can be used to store them efficiently by keeping only a single example around.
data InternedComponentStore c = InternedComponentStore {forall c. InternedComponentStore c -> IntMap (InternedComponent c)
_theInternedMap :: IM.IntMap (InternedComponent c), forall c. InternedComponentStore c -> EntitySet
_theInternedKeys :: EntitySet} deriving (InternedComponentStore c -> InternedComponentStore c -> Bool
(InternedComponentStore c -> InternedComponentStore c -> Bool)
-> (InternedComponentStore c -> InternedComponentStore c -> Bool)
-> Eq (InternedComponentStore c)
forall c.
InternedComponentStore c -> InternedComponentStore c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c.
InternedComponentStore c -> InternedComponentStore c -> Bool
== :: InternedComponentStore c -> InternedComponentStore c -> Bool
$c/= :: forall c.
InternedComponentStore c -> InternedComponentStore c -> Bool
/= :: InternedComponentStore c -> InternedComponentStore c -> Bool
Eq, Int -> InternedComponentStore c -> ShowS
[InternedComponentStore c] -> ShowS
InternedComponentStore c -> String
(Int -> InternedComponentStore c -> ShowS)
-> (InternedComponentStore c -> String)
-> ([InternedComponentStore c] -> ShowS)
-> Show (InternedComponentStore c)
forall c. Show c => Int -> InternedComponentStore c -> ShowS
forall c. Show c => [InternedComponentStore c] -> ShowS
forall c. Show c => InternedComponentStore c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> InternedComponentStore c -> ShowS
showsPrec :: Int -> InternedComponentStore c -> ShowS
$cshow :: forall c. Show c => InternedComponentStore c -> String
show :: InternedComponentStore c -> String
$cshowList :: forall c. Show c => [InternedComponentStore c] -> ShowS
showList :: [InternedComponentStore c] -> ShowS
Show, (forall x.
 InternedComponentStore c -> Rep (InternedComponentStore c) x)
-> (forall x.
    Rep (InternedComponentStore c) x -> InternedComponentStore c)
-> Generic (InternedComponentStore c)
forall x.
Rep (InternedComponentStore c) x -> InternedComponentStore c
forall x.
InternedComponentStore c -> Rep (InternedComponentStore c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x.
Rep (InternedComponentStore c) x -> InternedComponentStore c
forall c x.
InternedComponentStore c -> Rep (InternedComponentStore c) x
$cfrom :: forall c x.
InternedComponentStore c -> Rep (InternedComponentStore c) x
from :: forall x.
InternedComponentStore c -> Rep (InternedComponentStore c) x
$cto :: forall c x.
Rep (InternedComponentStore c) x -> InternedComponentStore c
to :: forall x.
Rep (InternedComponentStore c) x -> InternedComponentStore c
Generic, (forall a.
 InternedComponentStore a -> Rep1 InternedComponentStore a)
-> (forall a.
    Rep1 InternedComponentStore a -> InternedComponentStore a)
-> Generic1 InternedComponentStore
forall a. Rep1 InternedComponentStore a -> InternedComponentStore a
forall a. InternedComponentStore a -> Rep1 InternedComponentStore a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. InternedComponentStore a -> Rep1 InternedComponentStore a
from1 :: forall a. InternedComponentStore a -> Rep1 InternedComponentStore a
$cto1 :: forall a. Rep1 InternedComponentStore a -> InternedComponentStore a
to1 :: forall a. Rep1 InternedComponentStore a -> InternedComponentStore a
Generic1)

type instance Index (InternedComponentStore c) = Entity

type instance IxValue (InternedComponentStore c) = c

instance (Eq c, Hashable c) => At (InternedComponentStore c) where
  {-# INLINE at #-}
  at :: Index (InternedComponentStore c)
-> Lens'
     (InternedComponentStore c)
     (Maybe (IxValue (InternedComponentStore c)))
at (EntRef Int
k) Maybe (IxValue (InternedComponentStore c))
-> f (Maybe (IxValue (InternedComponentStore c)))
f cs :: InternedComponentStore c
cs@(InternedComponentStore IntMap (InternedComponent c)
s (EntitySet IntSet
ks)) =
    Maybe (IxValue (InternedComponentStore c))
-> f (Maybe (IxValue (InternedComponentStore c)))
f Maybe c
Maybe (IxValue (InternedComponentStore c))
mv f (Maybe c)
-> (Maybe c -> InternedComponentStore c)
-> f (InternedComponentStore c)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe c
r -> case Maybe c
r of
      Maybe c
Nothing -> InternedComponentStore c
-> (c -> InternedComponentStore c)
-> Maybe c
-> InternedComponentStore c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InternedComponentStore c
cs (InternedComponentStore c -> c -> InternedComponentStore c
forall a b. a -> b -> a
const (IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
forall c.
IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
InternedComponentStore (Int -> IntMap (InternedComponent c) -> IntMap (InternedComponent c)
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
k IntMap (InternedComponent c)
s) (IntSet -> EntitySet
EntitySet (Int -> IntSet -> IntSet
IS.delete Int
k IntSet
ks)))) Maybe c
mv
      Just c
v' -> IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
forall c.
IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
InternedComponentStore (Int
-> InternedComponent c
-> IntMap (InternedComponent c)
-> IntMap (InternedComponent c)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
k (Uninterned (InternedComponent c) -> InternedComponent c
forall t. Interned t => Uninterned t -> t
intern c
Uninterned (InternedComponent c)
v') IntMap (InternedComponent c)
s) (IntSet -> EntitySet
EntitySet (Int -> IntSet -> IntSet
IS.insert Int
k IntSet
ks))
    where
      mv :: Maybe c
mv = (InternedComponent c -> c)
-> Maybe (InternedComponent c) -> Maybe c
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InternedComponent c -> c
InternedComponent c -> Uninterned (InternedComponent c)
forall t. Uninternable t => t -> Uninterned t
unintern (Maybe (InternedComponent c) -> Maybe c)
-> Maybe (InternedComponent c) -> Maybe c
forall a b. (a -> b) -> a -> b
$ Int -> IntMap (InternedComponent c) -> Maybe (InternedComponent c)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k IntMap (InternedComponent c)
s

instance (Eq c, Hashable c) => Ixed (InternedComponentStore c) where
  {-# INLINE ix #-}
  ix :: Index (InternedComponentStore c)
-> Traversal'
     (InternedComponentStore c) (IxValue (InternedComponentStore c))
ix (EntRef Int
k) IxValue (InternedComponentStore c)
-> f (IxValue (InternedComponentStore c))
f (InternedComponentStore IntMap (InternedComponent c)
s EntitySet
ks) = (IntMap (InternedComponent c) -> InternedComponentStore c)
-> f (IntMap (InternedComponent c)) -> f (InternedComponentStore c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IntMap (InternedComponent c)
i -> IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
forall c.
IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
InternedComponentStore IntMap (InternedComponent c)
i EntitySet
ks) (f (IntMap (InternedComponent c)) -> f (InternedComponentStore c))
-> f (IntMap (InternedComponent c)) -> f (InternedComponentStore c)
forall a b. (a -> b) -> a -> b
$ Index (IntMap (InternedComponent c))
-> Traversal'
     (IntMap (InternedComponent c))
     (IxValue (IntMap (InternedComponent c)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (IntMap (InternedComponent c))
k ((c -> InternedComponent c) -> f c -> f (InternedComponent c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> InternedComponent c
Uninterned (InternedComponent c) -> InternedComponent c
forall t. Interned t => Uninterned t -> t
intern (f c -> f (InternedComponent c))
-> (InternedComponent c -> f c)
-> InternedComponent c
-> f (InternedComponent c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> f c
IxValue (InternedComponentStore c)
-> f (IxValue (InternedComponentStore c))
f (c -> f c)
-> (InternedComponent c -> c) -> InternedComponent c -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternedComponent c -> c
InternedComponent c -> Uninterned (InternedComponent c)
forall t. Uninternable t => t -> Uninterned t
unintern) IntMap (InternedComponent c)
s

instance AsEmpty (InternedComponentStore c) where
  {-# INLINE _Empty #-}
  _Empty :: Prism' (InternedComponentStore c) ()
_Empty = InternedComponentStore c
-> (InternedComponentStore c -> Bool)
-> Prism' (InternedComponentStore c) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly (IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
forall c.
IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
InternedComponentStore IntMap (InternedComponent c)
forall a. IntMap a
IM.empty (IntSet -> EntitySet
EntitySet IntSet
IS.empty)) (\(InternedComponentStore IntMap (InternedComponent c)
_ (EntitySet IntSet
ks)) -> IntSet -> Bool
IS.null IntSet
ks)

makeLenses ''InternedComponentStore

{-# INLINE toNormalCS #-}
toNormalCS :: (Uninternable (InternedComponent c)) => InternedComponentStore c -> ComponentStore c
toNormalCS :: forall c.
Uninternable (InternedComponent c) =>
InternedComponentStore c -> ComponentStore c
toNormalCS (InternedComponentStore IntMap (InternedComponent c)
ics EntitySet
iks) = IntMap c -> EntitySet -> ComponentStore c
forall c. IntMap c -> EntitySet -> ComponentStore c
ComponentStore ((InternedComponent c -> c)
-> IntMap (InternedComponent c) -> IntMap c
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InternedComponent c -> c
InternedComponent c -> Uninterned (InternedComponent c)
forall t. Uninternable t => t -> Uninterned t
unintern IntMap (InternedComponent c)
ics) EntitySet
iks

{-# INLINE toInternedCS #-}
toInternedCS :: (Interned (InternedComponent c)) => ComponentStore c -> InternedComponentStore c
toInternedCS :: forall c.
Interned (InternedComponent c) =>
ComponentStore c -> InternedComponentStore c
toInternedCS (ComponentStore IntMap c
cs EntitySet
ks) = IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
forall c.
IntMap (InternedComponent c)
-> EntitySet -> InternedComponentStore c
InternedComponentStore ((c -> InternedComponent c)
-> IntMap c -> IntMap (InternedComponent c)
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> InternedComponent c
Uninterned (InternedComponent c) -> InternedComponent c
forall t. Interned t => Uninterned t -> t
intern IntMap c
cs) EntitySet
ks

internedComponentStore :: (Uninternable (InternedComponent c)) => Iso' (ComponentStore c) (InternedComponentStore c)
internedComponentStore :: forall c.
Uninternable (InternedComponent c) =>
Iso' (ComponentStore c) (InternedComponentStore c)
internedComponentStore = (ComponentStore c -> InternedComponentStore c)
-> (InternedComponentStore c -> ComponentStore c)
-> Iso
     (ComponentStore c)
     (ComponentStore c)
     (InternedComponentStore c)
     (InternedComponentStore c)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ComponentStore c -> InternedComponentStore c
forall c.
Interned (InternedComponent c) =>
ComponentStore c -> InternedComponentStore c
toInternedCS InternedComponentStore c -> ComponentStore c
forall c.
Uninternable (InternedComponent c) =>
InternedComponentStore c -> ComponentStore c
toNormalCS
{-# INLINE internedComponentStore #-}

instance HasEntitySet (InternedComponentStore c) where
  {-# INLINE entitySet #-}
  entitySet :: Fold (InternedComponentStore c) EntitySet
entitySet = (EntitySet -> f EntitySet)
-> InternedComponentStore c -> f (InternedComponentStore c)
forall c (f :: * -> *).
Functor f =>
(EntitySet -> f EntitySet)
-> InternedComponentStore c -> f (InternedComponentStore c)
theInternedKeys

instance (Uninternable (InternedComponent c)) => EntityIndexedTraversable InternedComponentStore c where
  {-# INLINE entitiesTraversed #-}
  entitiesTraversed :: IndexedTraversal' Entity (InternedComponentStore c) c
entitiesTraversed = (AnIso
  (ComponentStore c)
  (ComponentStore c)
  (InternedComponentStore c)
  (InternedComponentStore c)
-> Iso
     (InternedComponentStore c)
     (InternedComponentStore c)
     (ComponentStore c)
     (ComponentStore c)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso
  (ComponentStore c)
  (ComponentStore c)
  (InternedComponentStore c)
  (InternedComponentStore c)
forall c.
Uninternable (InternedComponent c) =>
Iso' (ComponentStore c) (InternedComponentStore c)
Iso' (ComponentStore c) (InternedComponentStore c)
internedComponentStore) ((ComponentStore c -> f (ComponentStore c))
 -> InternedComponentStore c -> f (InternedComponentStore c))
-> (p c (f c) -> ComponentStore c -> f (ComponentStore c))
-> p c (f c)
-> InternedComponentStore c
-> f (InternedComponentStore c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p c (f c) -> ComponentStore c -> f (ComponentStore c)
forall (t :: * -> *) c.
EntityIndexedTraversable t c =>
IndexedTraversal' Entity (t c) c
IndexedTraversal' Entity (ComponentStore c) c
entitiesTraversed