{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Games.ECS.Entity
-- Description : Entity references.
-- Copyright   :  (C) 2020 Sophie Taylor
-- License     :  AGPL-3.0-or-later
-- Maintainer  :  Sophie Taylor <sophie@spacekitteh.moe>
-- Stability   :  experimental
-- Portability: GHC
--
-- In an ECS, an /entity/ is understood in two senses:
--
--     1. An identifying token, used to specify an /individual/, and
--     2. The /individual/ it refers to, that is, the set of components it has.
--
-- Here, we implement entities in the first sense.
module Games.ECS.Entity
  ( Entity (..),
    HasEntityReferences (..),
    EntitySet (EntitySet),
    theEntitySet,
    singletonEntitySet,
    asIntersection,
    IntersectionOfEntities (Intersect),
    IsEntityStore (..),
    HasEntitySet (..),
  )
where

import Control.Lens
import Data.Coerce
import Data.HashMap.Strict as HMS
import Data.HashSet qualified as HS
import Data.Hashable
import Data.Int
import Data.IntSet qualified as IS
import Data.IntSet.Lens
import Data.Ix
import Data.String
import Data.Vector.Unboxed.Deriving
import GHC.Generics
import Games.ECS.Serialisation
import System.ByteOrder

-- | A reference to an entity in the ECS.
newtype Entity = EntRef {Entity -> Int
unEntRef :: Int}
  deriving newtype (Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
/= :: Entity -> Entity -> Bool
Eq, Eq Entity
Eq Entity =>
(Entity -> Entity -> Ordering)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> Ord Entity
Entity -> Entity -> Bool
Entity -> Entity -> Ordering
Entity -> Entity -> Entity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Entity -> Entity -> Ordering
compare :: Entity -> Entity -> Ordering
$c< :: Entity -> Entity -> Bool
< :: Entity -> Entity -> Bool
$c<= :: Entity -> Entity -> Bool
<= :: Entity -> Entity -> Bool
$c> :: Entity -> Entity -> Bool
> :: Entity -> Entity -> Bool
$c>= :: Entity -> Entity -> Bool
>= :: Entity -> Entity -> Bool
$cmax :: Entity -> Entity -> Entity
max :: Entity -> Entity -> Entity
$cmin :: Entity -> Entity -> Entity
min :: Entity -> Entity -> Entity
Ord, Int -> Entity
Entity -> Int
Entity -> [Entity]
Entity -> Entity
Entity -> Entity -> [Entity]
Entity -> Entity -> Entity -> [Entity]
(Entity -> Entity)
-> (Entity -> Entity)
-> (Int -> Entity)
-> (Entity -> Int)
-> (Entity -> [Entity])
-> (Entity -> Entity -> [Entity])
-> (Entity -> Entity -> [Entity])
-> (Entity -> Entity -> Entity -> [Entity])
-> Enum Entity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Entity -> Entity
succ :: Entity -> Entity
$cpred :: Entity -> Entity
pred :: Entity -> Entity
$ctoEnum :: Int -> Entity
toEnum :: Int -> Entity
$cfromEnum :: Entity -> Int
fromEnum :: Entity -> Int
$cenumFrom :: Entity -> [Entity]
enumFrom :: Entity -> [Entity]
$cenumFromThen :: Entity -> Entity -> [Entity]
enumFromThen :: Entity -> Entity -> [Entity]
$cenumFromTo :: Entity -> Entity -> [Entity]
enumFromTo :: Entity -> Entity -> [Entity]
$cenumFromThenTo :: Entity -> Entity -> Entity -> [Entity]
enumFromThenTo :: Entity -> Entity -> Entity -> [Entity]
Enum, Entity
Entity -> Entity -> Bounded Entity
forall a. a -> a -> Bounded a
$cminBound :: Entity
minBound :: Entity
$cmaxBound :: Entity
maxBound :: Entity
Bounded, Ord Entity
Ord Entity =>
((Entity, Entity) -> [Entity])
-> ((Entity, Entity) -> Entity -> Int)
-> ((Entity, Entity) -> Entity -> Int)
-> ((Entity, Entity) -> Entity -> Bool)
-> ((Entity, Entity) -> Int)
-> ((Entity, Entity) -> Int)
-> Ix Entity
(Entity, Entity) -> Int
(Entity, Entity) -> [Entity]
(Entity, Entity) -> Entity -> Bool
(Entity, Entity) -> Entity -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Entity, Entity) -> [Entity]
range :: (Entity, Entity) -> [Entity]
$cindex :: (Entity, Entity) -> Entity -> Int
index :: (Entity, Entity) -> Entity -> Int
$cunsafeIndex :: (Entity, Entity) -> Entity -> Int
unsafeIndex :: (Entity, Entity) -> Entity -> Int
$cinRange :: (Entity, Entity) -> Entity -> Bool
inRange :: (Entity, Entity) -> Entity -> Bool
$crangeSize :: (Entity, Entity) -> Int
rangeSize :: (Entity, Entity) -> Int
$cunsafeRangeSize :: (Entity, Entity) -> Int
unsafeRangeSize :: (Entity, Entity) -> Int
Ix)
  deriving newtype (Name -> PU [Attribute] Entity
(Name -> PU [Attribute] Entity) -> XMLPickleAsAttribute Entity
forall a. (Name -> PU [Attribute] a) -> XMLPickleAsAttribute a
$cpickleAsAttribute :: Name -> PU [Attribute] Entity
pickleAsAttribute :: Name -> PU [Attribute] Entity
XMLPickleAsAttribute)
  deriving stock ((forall x. Entity -> Rep Entity x)
-> (forall x. Rep Entity x -> Entity) -> Generic Entity
forall x. Rep Entity x -> Entity
forall x. Entity -> Rep Entity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Entity -> Rep Entity x
from :: forall x. Entity -> Rep Entity x
$cto :: forall x. Rep Entity x -> Entity
to :: forall x. Rep Entity x -> Entity
Generic)

instance {-# OVERLAPS #-} XMLPickler [Node] Entity where
  {-# INLINE xpickle #-}
  xpickle :: PU [Node] Entity
xpickle = (Text
"Entity w/ attribute", Text
"") (Text, Text) -> PU [Node] Entity -> PU [Node] Entity
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (Name -> PU [Attribute] Entity -> PU [Node] Entity
forall b. Name -> PU [Attribute] b -> PU [Node] b
xpElemAttrs Name
"entity" (Name -> PU Text Entity -> PU [Attribute] Entity
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttribute Name
"entRef" ((Int -> Entity) -> (Entity -> Int) -> PU Text Int -> PU Text Entity
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Int -> Entity
EntRef Entity -> Int
unEntRef PU Text Int
forall a. (Show a, Read a) => PU Text a
xpPrim)))

-- | An instance for constructors which only  contain an entity reference; we put that as an attribute.
instance {-# OVERLAPPING #-} (Constructor c'', ty ~ (M1 C c'' (M1 S c (K1 i Entity)))) => GXmlPickler [Node] (M1 C c'' (M1 S c (K1 i Entity))) where
  {-# INLINE gxpickleContentsf #-}
  gxpickleContentsf :: forall a.
PU [Node] a -> PU [Node] (M1 C c'' (M1 S c (K1 i Entity)) a)
gxpickleContentsf PU [Node] a
_ = (Text
"Entity reference wrapper", Text
"") (Text, Text)
-> PU [Node] (M1 C c'' (M1 S c (K1 i Entity)) a)
-> PU [Node] (M1 C c'' (M1 S c (K1 i Entity)) a)
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (Name
-> PU [Attribute] (M1 C c'' (M1 S c (K1 i Entity)) a)
-> PU [Node] (M1 C c'' (M1 S c (K1 i Entity)) a)
forall b. Name -> PU [Attribute] b -> PU [Node] b
xpElemAttrs (String -> Name
forall a. IsString a => String -> a
fromString (String -> Name) -> (String -> String) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
formatElement (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ M1 C c'' (M1 S c (K1 i Entity)) Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c'' f a -> String
conName (ty p
forall {p :: k}. ty p
forall a. HasCallStack => a
undefined :: ty p)) ((Entity -> M1 C c'' (M1 S c (K1 i Entity)) a)
-> (M1 C c'' (M1 S c (K1 i Entity)) a -> Entity)
-> PU [Attribute] Entity
-> PU [Attribute] (M1 C c'' (M1 S c (K1 i Entity)) a)
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap (M1 S c (K1 i Entity) a -> M1 C c'' (M1 S c (K1 i Entity)) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 S c (K1 i Entity) a -> M1 C c'' (M1 S c (K1 i Entity)) a)
-> (Entity -> M1 S c (K1 i Entity) a)
-> Entity
-> M1 C c'' (M1 S c (K1 i Entity)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i Entity a -> M1 S c (K1 i Entity) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i Entity a -> M1 S c (K1 i Entity) a)
-> (Entity -> K1 i Entity a) -> Entity -> M1 S c (K1 i Entity) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity -> K1 i Entity a
forall k i c (p :: k). c -> K1 i c p
K1) (K1 i Entity a -> Entity
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 i Entity a -> Entity)
-> (M1 C c'' (M1 S c (K1 i Entity)) a -> K1 i Entity a)
-> M1 C c'' (M1 S c (K1 i Entity)) a
-> Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S c (K1 i Entity) a -> K1 i Entity a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 S c (K1 i Entity) a -> K1 i Entity a)
-> (M1 C c'' (M1 S c (K1 i Entity)) a -> M1 S c (K1 i Entity) a)
-> M1 C c'' (M1 S c (K1 i Entity)) a
-> K1 i Entity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C c'' (M1 S c (K1 i Entity)) a -> M1 S c (K1 i Entity) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1) (Name -> PU [Attribute] Entity
forall a. XMLPickleAsAttribute a => Name -> PU [Attribute] a
pickleAsAttribute Name
"entRef")))

-- | We reverse the byte order, just so there is a bit more variance between hashes.
instance Hashable Entity where
  {-# INLINE hash #-}
  hash :: Entity -> Int
hash (EntRef Int
i) = Int64 -> Int
forall a. Hashable a => a -> Int
hash (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ forall a. Bytes a => a -> a
toBigEndian @Int64 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> Entity -> Int
hashWithSalt Int
salt (EntRef Int
i) = Int -> Int64 -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (forall a. Bytes a => a -> a
toBigEndian @Int64 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i))

instance Show Entity where
  {-# INLINE show #-}
  show :: Entity -> String
show (EntRef Int
ref) = String
"EntRef: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ref

instance {-# OVERLAPPABLE #-} (XMLPickler [Node] v) => XMLPickler [Node] (HashMap Entity v) where
  {-# INLINE xpickle #-}
  xpickle :: PU [Node] (HashMap Entity v)
xpickle =
    (Text
"Entity-indexed HashMap", Text
"")
      (Text, Text)
-> PU [Node] (HashMap Entity v) -> PU [Node] (HashMap Entity v)
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> ( ([(Entity, v)] -> HashMap Entity v)
-> (HashMap Entity v -> [(Entity, v)])
-> PU [Node] [(Entity, v)]
-> PU [Node] (HashMap Entity v)
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap [(Entity, v)] -> HashMap Entity v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList HashMap Entity v -> [(Entity, v)]
forall k v. HashMap k v -> [(k, v)]
HMS.toList (PU [Node] [(Entity, v)] -> PU [Node] (HashMap Entity v))
-> PU [Node] [(Entity, v)] -> PU [Node] (HashMap Entity v)
forall a b. (a -> b) -> a -> b
$
               PU [Node] (Entity, v) -> PU [Node] [(Entity, v)]
forall a b. PU [a] b -> PU [a] [b]
xpAll (PU [Node] (Entity, v) -> PU [Node] [(Entity, v)])
-> PU [Node] (Entity, v) -> PU [Node] [(Entity, v)]
forall a b. (a -> b) -> a -> b
$
                 Name
-> PU [Attribute] Entity -> PU [Node] v -> PU [Node] (Entity, v)
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"li" (Name -> PU [Attribute] Entity
forall a. XMLPickleAsAttribute a => Name -> PU [Attribute] a
pickleAsAttribute Name
"entRef") PU [Node] v
forall t a. XMLPickler t a => PU t a
xpickle
           )

-- | A helper class for finding embedded entity references in components.
class HasEntityReferences c where
  getEntityReferences :: Fold c Entity

instance HasEntityReferences Entity where
  {-# INLINE getEntityReferences #-}
  getEntityReferences :: Fold Entity Entity
getEntityReferences = (Entity -> f Entity) -> Entity -> f Entity
forall a. a -> a
id

-- | An efficient storage for a collection of entities.
newtype EntitySet = EntitySet {EntitySet -> IntSet
_theEntitySet :: IS.IntSet}
  deriving newtype (EntitySet -> EntitySet -> Bool
(EntitySet -> EntitySet -> Bool)
-> (EntitySet -> EntitySet -> Bool) -> Eq EntitySet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntitySet -> EntitySet -> Bool
== :: EntitySet -> EntitySet -> Bool
$c/= :: EntitySet -> EntitySet -> Bool
/= :: EntitySet -> EntitySet -> Bool
Eq, Int -> EntitySet -> String -> String
[EntitySet] -> String -> String
EntitySet -> String
(Int -> EntitySet -> String -> String)
-> (EntitySet -> String)
-> ([EntitySet] -> String -> String)
-> Show EntitySet
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> EntitySet -> String -> String
showsPrec :: Int -> EntitySet -> String -> String
$cshow :: EntitySet -> String
show :: EntitySet -> String
$cshowList :: [EntitySet] -> String -> String
showList :: [EntitySet] -> String -> String
Show, NonEmpty EntitySet -> EntitySet
EntitySet -> EntitySet -> EntitySet
(EntitySet -> EntitySet -> EntitySet)
-> (NonEmpty EntitySet -> EntitySet)
-> (forall b. Integral b => b -> EntitySet -> EntitySet)
-> Semigroup EntitySet
forall b. Integral b => b -> EntitySet -> EntitySet
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: EntitySet -> EntitySet -> EntitySet
<> :: EntitySet -> EntitySet -> EntitySet
$csconcat :: NonEmpty EntitySet -> EntitySet
sconcat :: NonEmpty EntitySet -> EntitySet
$cstimes :: forall b. Integral b => b -> EntitySet -> EntitySet
stimes :: forall b. Integral b => b -> EntitySet -> EntitySet
Semigroup, Semigroup EntitySet
EntitySet
Semigroup EntitySet =>
EntitySet
-> (EntitySet -> EntitySet -> EntitySet)
-> ([EntitySet] -> EntitySet)
-> Monoid EntitySet
[EntitySet] -> EntitySet
EntitySet -> EntitySet -> EntitySet
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: EntitySet
mempty :: EntitySet
$cmappend :: EntitySet -> EntitySet -> EntitySet
mappend :: EntitySet -> EntitySet -> EntitySet
$cmconcat :: [EntitySet] -> EntitySet
mconcat :: [EntitySet] -> EntitySet
Monoid)

instance HasEntityReferences EntitySet where
  {-# INLINE getEntityReferences #-}
  getEntityReferences :: Fold EntitySet Entity
getEntityReferences = (IntSet -> f IntSet) -> EntitySet -> f EntitySet
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso EntitySet EntitySet IntSet IntSet
coerced ((IntSet -> f IntSet) -> EntitySet -> f EntitySet)
-> ((Entity -> f Entity) -> IntSet -> f IntSet)
-> (Entity -> f Entity)
-> EntitySet
-> f EntitySet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> IntSet -> f IntSet
Fold IntSet Int
members ((Int -> f Int) -> IntSet -> f IntSet)
-> ((Entity -> f Entity) -> Int -> f Int)
-> (Entity -> f Entity)
-> IntSet
-> f IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Entity) -> (Entity -> f Entity) -> Int -> f Int
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Control.Lens.to Int -> Entity
EntRef

makeLensesWith (lensRules & generateSignatures .~ False) ''EntitySet

-- | Access the underlying 'IS.IntSet'.
theEntitySet :: Iso' EntitySet IS.IntSet

{-# INLINE singletonEntitySet #-}

-- | Construct a new t'EntitySet' with a given 'Entity'.
singletonEntitySet :: Entity -> EntitySet
singletonEntitySet :: Entity -> EntitySet
singletonEntitySet (EntRef Int
k) = IntSet -> EntitySet
EntitySet (Int -> IntSet
IS.singleton Int
k)

{-# INLINE asIntersection #-}

-- | Helper `Iso'` for selecting entities which satisfy predicates.
asIntersection :: Iso' IntersectionOfEntities EntitySet
asIntersection :: Iso' IntersectionOfEntities EntitySet
asIntersection = (IntersectionOfEntities -> EntitySet)
-> (EntitySet -> IntersectionOfEntities)
-> Iso' IntersectionOfEntities EntitySet
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\case Intersect IntSet
es -> IntSet -> EntitySet
EntitySet IntSet
es) (IntSet -> IntersectionOfEntities
Intersect (IntSet -> IntersectionOfEntities)
-> (EntitySet -> IntSet) -> EntitySet -> IntersectionOfEntities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntitySet -> IntSet
_theEntitySet)

-- | A helper 'Monoid' for selecting entities which satisfy multiple predicates.
newtype IntersectionOfEntities = Intersect {IntersectionOfEntities -> IntSet
_unIntersect :: IS.IntSet} deriving stock (IntersectionOfEntities -> IntersectionOfEntities -> Bool
(IntersectionOfEntities -> IntersectionOfEntities -> Bool)
-> (IntersectionOfEntities -> IntersectionOfEntities -> Bool)
-> Eq IntersectionOfEntities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntersectionOfEntities -> IntersectionOfEntities -> Bool
== :: IntersectionOfEntities -> IntersectionOfEntities -> Bool
$c/= :: IntersectionOfEntities -> IntersectionOfEntities -> Bool
/= :: IntersectionOfEntities -> IntersectionOfEntities -> Bool
Eq, Int -> IntersectionOfEntities -> String -> String
[IntersectionOfEntities] -> String -> String
IntersectionOfEntities -> String
(Int -> IntersectionOfEntities -> String -> String)
-> (IntersectionOfEntities -> String)
-> ([IntersectionOfEntities] -> String -> String)
-> Show IntersectionOfEntities
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> IntersectionOfEntities -> String -> String
showsPrec :: Int -> IntersectionOfEntities -> String -> String
$cshow :: IntersectionOfEntities -> String
show :: IntersectionOfEntities -> String
$cshowList :: [IntersectionOfEntities] -> String -> String
showList :: [IntersectionOfEntities] -> String -> String
Show)

instance Semigroup IntersectionOfEntities where
  {-# INLINE (<>) #-}
  (Intersect IntSet
a) <> :: IntersectionOfEntities
-> IntersectionOfEntities -> IntersectionOfEntities
<> (Intersect IntSet
b) = IntSet -> IntersectionOfEntities
Intersect (IntSet -> IntSet -> IntSet
IS.intersection IntSet
a IntSet
b)

instance Monoid IntersectionOfEntities where
  mempty :: IntersectionOfEntities
mempty = String -> IntersectionOfEntities
forall a. HasCallStack => String -> a
error String
"mempty IntersectionOfEntities"

-- | Generalisation of an t'EntitySet'.
class IsEntityStore a where
  -- | 'Control.Lens.Type.Fold' over each 'Entity' it holds.
  knownEntities :: Fold a Entity

  -- | Empty storage.
  blankEntityStorage :: a

instance IsEntityStore (HS.HashSet Entity) where
  {-# INLINE knownEntities #-}
  knownEntities :: Fold (HashSet Entity) Entity
knownEntities = (Entity -> f Entity) -> HashSet Entity -> f (HashSet Entity)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (HashSet Entity) Entity
folded
  blankEntityStorage :: HashSet Entity
blankEntityStorage = HashSet Entity
forall a. HashSet a
HS.empty

instance IsEntityStore IS.IntSet where
  {-# INLINE knownEntities #-}
  knownEntities :: Fold IntSet Entity
knownEntities = (Int -> f Int) -> IntSet -> f IntSet
Fold IntSet Int
members ((Int -> f Int) -> IntSet -> f IntSet)
-> ((Entity -> f Entity) -> Int -> f Int)
-> (Entity -> f Entity)
-> IntSet
-> f IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced @Int @Int @Entity @Entity
  blankEntityStorage :: IntSet
blankEntityStorage = IntSet
IS.empty

instance IsEntityStore EntitySet where
  {-# INLINE knownEntities #-}
  knownEntities :: Fold EntitySet Entity
knownEntities = (IntSet -> f IntSet) -> EntitySet -> f EntitySet
Iso EntitySet EntitySet IntSet IntSet
theEntitySet ((IntSet -> f IntSet) -> EntitySet -> f EntitySet)
-> ((Entity -> f Entity) -> IntSet -> f IntSet)
-> (Entity -> f Entity)
-> EntitySet
-> f EntitySet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> f Entity) -> IntSet -> f IntSet
forall a. IsEntityStore a => Fold a Entity
Fold IntSet Entity
knownEntities
  blankEntityStorage :: EntitySet
blankEntityStorage = IntSet -> EntitySet
EntitySet IntSet
forall a. IsEntityStore a => a
blankEntityStorage

instance IsEntityStore IntersectionOfEntities where
  {-# INLINE knownEntities #-}
  knownEntities :: Fold IntersectionOfEntities Entity
knownEntities = (EntitySet -> f EntitySet)
-> IntersectionOfEntities -> f IntersectionOfEntities
Iso' IntersectionOfEntities EntitySet
asIntersection ((EntitySet -> f EntitySet)
 -> IntersectionOfEntities -> f IntersectionOfEntities)
-> ((Entity -> f Entity) -> EntitySet -> f EntitySet)
-> (Entity -> f Entity)
-> IntersectionOfEntities
-> f IntersectionOfEntities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> f Entity) -> EntitySet -> f EntitySet
forall a. IsEntityStore a => Fold a Entity
Fold EntitySet Entity
knownEntities
  blankEntityStorage :: IntersectionOfEntities
blankEntityStorage = IntSet -> IntersectionOfEntities
Intersect IntSet
forall a. IsEntityStore a => a
blankEntityStorage

derivingUnbox
  "Entity"
  [t|Entity -> Int|]
  [|coerce|]
  [|coerce|]

-- | For types which may have one or more t'EntitySet'.
class HasEntitySet a where
  entitySet :: Fold a EntitySet

instance HasEntitySet EntitySet where
  {-# INLINE entitySet #-}
  entitySet :: Fold EntitySet EntitySet
entitySet = (EntitySet -> f EntitySet) -> EntitySet -> f EntitySet
forall {k2} (a :: k2) k3 (p :: k2 -> k3 -> *) (f :: k2 -> k3).
p a (f a) -> p a (f a)
simple

instance HasEntitySet IntersectionOfEntities where
  {-# INLINE entitySet #-}
  entitySet :: Fold IntersectionOfEntities EntitySet
entitySet = (EntitySet -> f EntitySet)
-> IntersectionOfEntities -> f IntersectionOfEntities
Iso' IntersectionOfEntities EntitySet
asIntersection