{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Data.Aztecs.Query
  ( Query (..),
    (<?>),
    fetch,
    all,
    allWorld,
    map,
    mapWorld,
    mapWith,
  )
where

import Control.Monad.State (MonadState (..), gets)
import Data.Aztecs.Access (Access (Access))
import Data.Aztecs.Archetype (Archetype)
import qualified Data.Aztecs.Archetype as A
import Data.Aztecs.Core
import Data.Aztecs.Entity (ConcatT, Difference, DifferenceT, Entity (..), EntityT, FromEntity (..), Intersect, IntersectT, ToEntity (..))
import qualified Data.Aztecs.Entity as E
import Data.Aztecs.World (World (..))
import Data.Data (Typeable)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import qualified Data.Set as Set
import Prelude hiding (all, map)

-- | Query into the `World`.

newtype Query a
  = Query {forall (a :: [*]).
Query a
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
runQuery' :: Components -> (Set ComponentID, Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))}

(<?>) ::
  (E.Split a (ConcatT a b), E.SplitT a (ConcatT a b) ~ b) =>
  Query a ->
  Query b ->
  Query (ConcatT a b)
(Query Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
a) <?> :: forall (a :: [*]) (b :: [*]).
(Split a (ConcatT a b), SplitT a (ConcatT a b) ~ b) =>
Query a -> Query b -> Query (ConcatT a b)
<?> (Query Components
-> (Set ComponentID,
    Archetype -> ([Entity b], [Entity b] -> Archetype -> Archetype))
b) = (Components
 -> (Set ComponentID,
     Archetype
     -> ([Entity (ConcatT a b)],
         [Entity (ConcatT a b)] -> Archetype -> Archetype)))
-> Query (ConcatT a b)
forall (a :: [*]).
(Components
 -> (Set ComponentID,
     Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)))
-> Query a
Query ((Components
  -> (Set ComponentID,
      Archetype
      -> ([Entity (ConcatT a b)],
          [Entity (ConcatT a b)] -> Archetype -> Archetype)))
 -> Query (ConcatT a b))
-> (Components
    -> (Set ComponentID,
        Archetype
        -> ([Entity (ConcatT a b)],
            [Entity (ConcatT a b)] -> Archetype -> Archetype)))
-> Query (ConcatT a b)
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let (Set ComponentID
aIds, Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)
a') = Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
a Components
cs
      (Set ComponentID
bIds, Archetype -> ([Entity b], [Entity b] -> Archetype -> Archetype)
b') = Components
-> (Set ComponentID,
    Archetype -> ([Entity b], [Entity b] -> Archetype -> Archetype))
b Components
cs
   in ( Set ComponentID
aIds Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Set ComponentID
bIds,
        \Archetype
arch ->
          let ([Entity a]
a'', [Entity a] -> Archetype -> Archetype
aF) = Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)
a' Archetype
arch
              ([Entity b]
b'', [Entity b] -> Archetype -> Archetype
bF) = Archetype -> ([Entity b], [Entity b] -> Archetype -> Archetype)
b' Archetype
arch
           in ( (Entity a -> Entity b -> Entity (ConcatT a b))
-> (Entity a, Entity b) -> Entity (ConcatT a b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Entity a -> Entity b -> Entity (ConcatT a b)
forall (as :: [*]) (bs :: [*]).
Entity as -> Entity bs -> Entity (ConcatT as bs)
E.concat ((Entity a, Entity b) -> Entity (ConcatT a b))
-> [(Entity a, Entity b)] -> [Entity (ConcatT a b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Entity a] -> [Entity b] -> [(Entity a, Entity b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Entity a]
a'' [Entity b]
b'',
                \[Entity (ConcatT a b)]
new Archetype
newArch -> let ([Entity a]
as, [Entity b]
bs) = [(Entity a, Entity b)] -> ([Entity a], [Entity b])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Entity a, Entity b)] -> ([Entity a], [Entity b]))
-> [(Entity a, Entity b)] -> ([Entity a], [Entity b])
forall a b. (a -> b) -> a -> b
$ (Entity (ConcatT a b) -> (Entity a, Entity b))
-> [Entity (ConcatT a b)] -> [(Entity a, Entity b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity (ConcatT a b) -> (Entity a, Entity b)
Entity (ConcatT a b) -> (Entity a, Entity (SplitT a (ConcatT a b)))
forall (a :: [*]) (b :: [*]).
Split a b =>
Entity b -> (Entity a, Entity (SplitT a b))
E.split [Entity (ConcatT a b)]
new in [Entity b] -> Archetype -> Archetype
bF [Entity b]
bs (Archetype -> Archetype) -> Archetype -> Archetype
forall a b. (a -> b) -> a -> b
$ [Entity a] -> Archetype -> Archetype
aF [Entity a]
as Archetype
newArch
              )
      )

fetch :: forall a. (Component a, Typeable (StorageT a)) => Query '[a]
fetch :: forall a. (Component a, Typeable (StorageT a)) => Query '[a]
fetch = (Components
 -> (Set ComponentID,
     Archetype
     -> ([Entity '[a]], [Entity '[a]] -> Archetype -> Archetype)))
-> Query '[a]
forall (a :: [*]).
(Components
 -> (Set ComponentID,
     Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)))
-> Query a
Query ((Components
  -> (Set ComponentID,
      Archetype
      -> ([Entity '[a]], [Entity '[a]] -> Archetype -> Archetype)))
 -> Query '[a])
-> (Components
    -> (Set ComponentID,
        Archetype
        -> ([Entity '[a]], [Entity '[a]] -> Archetype -> Archetype)))
-> Query '[a]
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let cId :: ComponentID
cId = ComponentID -> Maybe ComponentID -> ComponentID
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ComponentID
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO") (forall a. Typeable a => Components -> Maybe ComponentID
lookupComponentId @a Components
cs)
   in ( ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId,
        \Archetype
arch ->
          let as :: [(EntityID, a)]
as = ComponentID -> Archetype -> [(EntityID, a)]
forall a.
Component a =>
ComponentID -> Archetype -> [(EntityID, a)]
A.all ComponentID
cId Archetype
arch
           in ( ((EntityID, a) -> Entity '[a]) -> [(EntityID, a)] -> [Entity '[a]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(EntityID, a)
x -> a -> Entity '[] -> Entity '[a]
forall t (ts1 :: [*]). t -> Entity ts1 -> Entity (t : ts1)
ECons ((EntityID, a) -> a
forall a b. (a, b) -> b
snd (EntityID, a)
x) Entity '[]
ENil) [(EntityID, a)]
as,
                ComponentID -> [(EntityID, a)] -> Archetype -> Archetype
forall a.
Component a =>
ComponentID -> [(EntityID, a)] -> Archetype -> Archetype
A.insertAscList ComponentID
cId ([(EntityID, a)] -> Archetype -> Archetype)
-> ([Entity '[a]] -> [(EntityID, a)])
-> [Entity '[a]]
-> Archetype
-> Archetype
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((EntityID, a), Entity '[a]) -> (EntityID, a))
-> [((EntityID, a), Entity '[a])] -> [(EntityID, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((EntityID
e, a
_), ECons t
a Entity ts1
ENil) -> (EntityID
e, a
t
a)) ([((EntityID, a), Entity '[a])] -> [(EntityID, a)])
-> ([Entity '[a]] -> [((EntityID, a), Entity '[a])])
-> [Entity '[a]]
-> [(EntityID, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(EntityID, a)] -> [Entity '[a]] -> [((EntityID, a), Entity '[a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [(EntityID, a)]
as
              )
      )

all :: forall m a. (Monad m, ToEntity a, FromEntity a, ToQuery (EntityT a)) => Access m [a]
all :: forall (m :: * -> *) a.
(Monad m, ToEntity a, FromEntity a, ToQuery (EntityT a)) =>
Access m [a]
all = StateT World m [a] -> Access m [a]
forall (m :: * -> *) a. StateT World m a -> Access m a
Access (StateT World m [a] -> Access m [a])
-> StateT World m [a] -> Access m [a]
forall a b. (a -> b) -> a -> b
$ (World -> [a]) -> StateT World m [a]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Entity (EntityT a) -> a) -> [Entity (EntityT a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity (EntityT a) -> a
forall a. FromEntity a => Entity (EntityT a) -> a
fromEntity ([Entity (EntityT a)] -> [a])
-> (World -> [Entity (EntityT a)]) -> World -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query (EntityT a) -> World -> [Entity (EntityT a)]
forall (a :: [*]). Query a -> World -> [Entity a]
allWorld (forall (a :: [*]). ToQuery a => Query a
query @(EntityT a)))

allWorld :: Query a -> World -> [Entity a]
allWorld :: forall (a :: [*]). Query a -> World -> [Entity a]
allWorld Query a
q World
w =
  let (Set ComponentID
cIds, Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)
g) = Query a
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
forall (a :: [*]).
Query a
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
runQuery' Query a
q (World -> Components
components World
w)
      res :: Maybe Archetype
res = do
        ArchetypeID
aId <- Set ComponentID
-> Map (Set ComponentID) ArchetypeID -> Maybe ArchetypeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Set ComponentID
cIds (World -> Map (Set ComponentID) ArchetypeID
archetypeIds World
w)
        ArchetypeID -> Map ArchetypeID Archetype -> Maybe Archetype
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ArchetypeID
aId (World -> Map ArchetypeID Archetype
archetypes World
w)
   in case Maybe Archetype
res of
        Just Archetype
arch -> ([Entity a], [Entity a] -> Archetype -> Archetype) -> [Entity a]
forall a b. (a, b) -> a
fst (([Entity a], [Entity a] -> Archetype -> Archetype) -> [Entity a])
-> ([Entity a], [Entity a] -> Archetype -> Archetype) -> [Entity a]
forall a b. (a -> b) -> a -> b
$ Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)
g Archetype
arch
        Maybe Archetype
Nothing -> []

mapWith ::
  (FromEntity i, ToEntity o, EntityT i ~ ConcatT a b, EntityT o ~ b) =>
  Query a ->
  Query b ->
  (i -> o) ->
  World ->
  ([o], World)
mapWith :: forall i o (a :: [*]) (b :: [*]).
(FromEntity i, ToEntity o, EntityT i ~ ConcatT a b,
 EntityT o ~ b) =>
Query a -> Query b -> (i -> o) -> World -> ([o], World)
mapWith Query a
a Query b
b i -> o
f World
w =
  let (Set ComponentID
aCIds, Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)
aG) = Query a
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
forall (a :: [*]).
Query a
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
runQuery' Query a
a (World -> Components
components World
w)
      (Set ComponentID
bCIds, Archetype -> ([Entity b], [Entity b] -> Archetype -> Archetype)
bG) = Query b
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity b], [Entity b] -> Archetype -> Archetype))
forall (a :: [*]).
Query a
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
runQuery' Query b
b (World -> Components
components World
w)
      res :: Maybe (ArchetypeID, Archetype)
res = do
        ArchetypeID
aId <- Set ComponentID
-> Map (Set ComponentID) ArchetypeID -> Maybe ArchetypeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Set ComponentID
aCIds Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Set ComponentID
bCIds) (World -> Map (Set ComponentID) ArchetypeID
archetypeIds World
w)
        Archetype
arch <- ArchetypeID -> Map ArchetypeID Archetype -> Maybe Archetype
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ArchetypeID
aId (World -> Map ArchetypeID Archetype
archetypes World
w)
        (ArchetypeID, Archetype) -> Maybe (ArchetypeID, Archetype)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArchetypeID
aId, Archetype
arch)
   in case Maybe (ArchetypeID, Archetype)
res of
        Just (ArchetypeID
aId, Archetype
arch) ->
          let ([Entity a]
as, [Entity a] -> Archetype -> Archetype
_) = Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)
aG Archetype
arch
              ([Entity b]
bs, [Entity b] -> Archetype -> Archetype
bH) = Archetype -> ([Entity b], [Entity b] -> Archetype -> Archetype)
bG Archetype
arch
              es :: [o]
es = ((Entity a, Entity b) -> o) -> [(Entity a, Entity b)] -> [o]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Entity a
aE, Entity b
bE) -> i -> o
f (i -> o) -> i -> o
forall a b. (a -> b) -> a -> b
$ Entity (EntityT i) -> i
forall a. FromEntity a => Entity (EntityT a) -> a
fromEntity (Entity a -> Entity b -> Entity (ConcatT a b)
forall (as :: [*]) (bs :: [*]).
Entity as -> Entity bs -> Entity (ConcatT as bs)
E.concat Entity a
aE Entity b
bE)) ([Entity a] -> [Entity b] -> [(Entity a, Entity b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Entity a]
as [Entity b]
bs)
              arch' :: Archetype
arch' = [Entity b] -> Archetype -> Archetype
bH ((o -> Entity b) -> [o] -> [Entity b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity b -> Entity b
Entity b -> Entity (EntityT (Entity b))
forall a. ToEntity a => a -> Entity (EntityT a)
toEntity (Entity b -> Entity b) -> (o -> Entity b) -> o -> Entity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> Entity b
o -> Entity (EntityT o)
forall a. ToEntity a => a -> Entity (EntityT a)
toEntity) [o]
es) Archetype
arch
           in ([o]
es, World
w {archetypes = Map.insert aId arch' (archetypes w)})
        Maybe (ArchetypeID, Archetype)
Nothing -> ([], World
w)

class ToQuery a where
  query :: Query a

instance ToQuery '[] where
  query :: Query '[]
query = (Components
 -> (Set ComponentID,
     Archetype
     -> ([Entity '[]], [Entity '[]] -> Archetype -> Archetype)))
-> Query '[]
forall (a :: [*]).
(Components
 -> (Set ComponentID,
     Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype)))
-> Query a
Query ((Components
  -> (Set ComponentID,
      Archetype
      -> ([Entity '[]], [Entity '[]] -> Archetype -> Archetype)))
 -> Query '[])
-> (Components
    -> (Set ComponentID,
        Archetype
        -> ([Entity '[]], [Entity '[]] -> Archetype -> Archetype)))
-> Query '[]
forall a b. (a -> b) -> a -> b
$ (Set ComponentID,
 Archetype
 -> ([Entity '[]], [Entity '[]] -> Archetype -> Archetype))
-> Components
-> (Set ComponentID,
    Archetype
    -> ([Entity '[]], [Entity '[]] -> Archetype -> Archetype))
forall a b. a -> b -> a
const (Set ComponentID
forall a. Set a
Set.empty, ([Entity '[]], [Entity '[]] -> Archetype -> Archetype)
-> Archetype
-> ([Entity '[]], [Entity '[]] -> Archetype -> Archetype)
forall a b. a -> b -> a
const ([], \[Entity '[]]
_ Archetype
arch' -> Archetype
arch'))

instance {-# OVERLAPPING #-} (Component a, Typeable (StorageT a)) => ToQuery '[a] where
  query :: Query '[a]
query = forall a. (Component a, Typeable (StorageT a)) => Query '[a]
fetch @a

instance (Component a, Typeable (StorageT a), ToQuery as) => ToQuery (a ': as) where
  query :: Query (a : as)
query = forall a. (Component a, Typeable (StorageT a)) => Query '[a]
fetch @a Query '[a] -> Query as -> Query (ConcatT '[a] as)
forall (a :: [*]) (b :: [*]).
(Split a (ConcatT a b), SplitT a (ConcatT a b) ~ b) =>
Query a -> Query b -> Query (ConcatT a b)
<?> forall (a :: [*]). ToQuery a => Query a
query @as

mapWorld ::
  forall i o.
  ( FromEntity i,
    ToEntity o,
    Intersect (EntityT i) (EntityT o),
    ToQuery (IntersectT (EntityT i) (EntityT o)),
    Difference (EntityT i) (EntityT o),
    ToQuery (DifferenceT (EntityT i) (EntityT o)),
    ConcatT (DifferenceT (EntityT i) (EntityT o)) (IntersectT (EntityT i) (EntityT o)) ~ EntityT i,
    IntersectT (EntityT i) (EntityT o) ~ EntityT o
  ) =>
  (i -> o) ->
  World ->
  ([o], World)
mapWorld :: forall i o.
(FromEntity i, ToEntity o, Intersect (EntityT i) (EntityT o),
 ToQuery (IntersectT (EntityT i) (EntityT o)),
 Difference (EntityT i) (EntityT o),
 ToQuery (DifferenceT (EntityT i) (EntityT o)),
 ConcatT
   (DifferenceT (EntityT i) (EntityT o))
   (IntersectT (EntityT i) (EntityT o))
 ~ EntityT i,
 IntersectT (EntityT i) (EntityT o) ~ EntityT o) =>
(i -> o) -> World -> ([o], World)
mapWorld i -> o
f World
w =
  let i :: Query (IntersectT (EntityT i) (EntityT o))
i = forall (a :: [*]). ToQuery a => Query a
query @(IntersectT (EntityT i) (EntityT o))
      o :: Query (DifferenceT (EntityT i) (EntityT o))
o = forall (a :: [*]). ToQuery a => Query a
query @(DifferenceT (EntityT i) (EntityT o))
      (Set ComponentID
aCIds, Archetype
-> ([Entity (EntityT o)],
    [Entity (EntityT o)] -> Archetype -> Archetype)
aG) = Query (EntityT o)
-> Components
-> (Set ComponentID,
    Archetype
    -> ([Entity (EntityT o)],
        [Entity (EntityT o)] -> Archetype -> Archetype))
forall (a :: [*]).
Query a
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
runQuery' Query (IntersectT (EntityT i) (EntityT o))
Query (EntityT o)
i (World -> Components
components World
w)
      (Set ComponentID
bCIds, Archetype
-> ([Entity (DifferenceT (EntityT i) (EntityT o))],
    [Entity (DifferenceT (EntityT i) (EntityT o))]
    -> Archetype -> Archetype)
bG) = Query (DifferenceT (EntityT i) (EntityT o))
-> Components
-> (Set ComponentID,
    Archetype
    -> ([Entity (DifferenceT (EntityT i) (EntityT o))],
        [Entity (DifferenceT (EntityT i) (EntityT o))]
        -> Archetype -> Archetype))
forall (a :: [*]).
Query a
-> Components
-> (Set ComponentID,
    Archetype -> ([Entity a], [Entity a] -> Archetype -> Archetype))
runQuery' Query (DifferenceT (EntityT i) (EntityT o))
o (World -> Components
components World
w)
      res :: Maybe (ArchetypeID, Archetype)
res = do
        ArchetypeID
aId <- Set ComponentID
-> Map (Set ComponentID) ArchetypeID -> Maybe ArchetypeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Set ComponentID
aCIds Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Set ComponentID
bCIds) (World -> Map (Set ComponentID) ArchetypeID
archetypeIds World
w)
        Archetype
arch <- ArchetypeID -> Map ArchetypeID Archetype -> Maybe Archetype
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ArchetypeID
aId (World -> Map ArchetypeID Archetype
archetypes World
w)
        (ArchetypeID, Archetype) -> Maybe (ArchetypeID, Archetype)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArchetypeID
aId, Archetype
arch)
   in case Maybe (ArchetypeID, Archetype)
res of
        Just (ArchetypeID
aId, Archetype
arch) ->
          let ([Entity (EntityT o)]
as, [Entity (EntityT o)] -> Archetype -> Archetype
aH) = Archetype
-> ([Entity (EntityT o)],
    [Entity (EntityT o)] -> Archetype -> Archetype)
aG Archetype
arch
              ([Entity (DifferenceT (EntityT i) (EntityT o))]
bs, [Entity (DifferenceT (EntityT i) (EntityT o))]
-> Archetype -> Archetype
_) = Archetype
-> ([Entity (DifferenceT (EntityT i) (EntityT o))],
    [Entity (DifferenceT (EntityT i) (EntityT o))]
    -> Archetype -> Archetype)
bG Archetype
arch
              es :: [o]
es = ((Entity (EntityT o), Entity (DifferenceT (EntityT i) (EntityT o)))
 -> o)
-> [(Entity (EntityT o),
     Entity (DifferenceT (EntityT i) (EntityT o)))]
-> [o]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Entity (EntityT o)
aE, Entity (DifferenceT (EntityT i) (EntityT o))
bE) -> i -> o
f (i -> o) -> i -> o
forall a b. (a -> b) -> a -> b
$ forall a. FromEntity a => Entity (EntityT a) -> a
fromEntity @i (Entity (DifferenceT (EntityT i) (EntityT o))
-> Entity (EntityT o)
-> Entity
     (ConcatT (DifferenceT (EntityT i) (EntityT o)) (EntityT o))
forall (as :: [*]) (bs :: [*]).
Entity as -> Entity bs -> Entity (ConcatT as bs)
E.concat Entity (DifferenceT (EntityT i) (EntityT o))
bE Entity (EntityT o)
aE)) ([Entity (EntityT o)]
-> [Entity (DifferenceT (EntityT i) (EntityT o))]
-> [(Entity (EntityT o),
     Entity (DifferenceT (EntityT i) (EntityT o)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Entity (EntityT o)]
as [Entity (DifferenceT (EntityT i) (EntityT o))]
bs)
              arch' :: Archetype
arch' = [Entity (EntityT o)] -> Archetype -> Archetype
aH ((o -> Entity (EntityT o)) -> [o] -> [Entity (EntityT o)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\o
x -> let e :: Entity (EntityT o)
e = o -> Entity (EntityT o)
forall a. ToEntity a => a -> Entity (EntityT a)
toEntity o
x in Entity (EntityT o)
e) [o]
es) Archetype
arch
           in ([o]
es, World
w {archetypes = Map.insert aId arch' (archetypes w)})
        Maybe (ArchetypeID, Archetype)
Nothing -> ([], World
w)

map ::
  forall m i o.
  ( Monad m,
    FromEntity i,
    ToEntity o,
    Intersect (EntityT i) (EntityT o),
    ToQuery (IntersectT (EntityT i) (EntityT o)),
    Difference (EntityT i) (EntityT o),
    ToQuery (DifferenceT (EntityT i) (EntityT o)),
    ConcatT (DifferenceT (EntityT i) (EntityT o)) (IntersectT (EntityT i) (EntityT o)) ~ EntityT i,
    IntersectT (EntityT i) (EntityT o) ~ EntityT o
  ) =>
  (i -> o) ->
  Access m [o]
map :: forall (m :: * -> *) i o.
(Monad m, FromEntity i, ToEntity o,
 Intersect (EntityT i) (EntityT o),
 ToQuery (IntersectT (EntityT i) (EntityT o)),
 Difference (EntityT i) (EntityT o),
 ToQuery (DifferenceT (EntityT i) (EntityT o)),
 ConcatT
   (DifferenceT (EntityT i) (EntityT o))
   (IntersectT (EntityT i) (EntityT o))
 ~ EntityT i,
 IntersectT (EntityT i) (EntityT o) ~ EntityT o) =>
(i -> o) -> Access m [o]
map i -> o
f = StateT World m [o] -> Access m [o]
forall (m :: * -> *) a. StateT World m a -> Access m a
Access (StateT World m [o] -> Access m [o])
-> StateT World m [o] -> Access m [o]
forall a b. (a -> b) -> a -> b
$ do
  World
w <- StateT World m World
forall s (m :: * -> *). MonadState s m => m s
get
  let ([o]
out, World
w') = forall i o.
(FromEntity i, ToEntity o, Intersect (EntityT i) (EntityT o),
 ToQuery (IntersectT (EntityT i) (EntityT o)),
 Difference (EntityT i) (EntityT o),
 ToQuery (DifferenceT (EntityT i) (EntityT o)),
 ConcatT
   (DifferenceT (EntityT i) (EntityT o))
   (IntersectT (EntityT i) (EntityT o))
 ~ EntityT i,
 IntersectT (EntityT i) (EntityT o) ~ EntityT o) =>
(i -> o) -> World -> ([o], World)
mapWorld @i @o i -> o
f World
w
  World -> StateT World m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World
w'
  [o] -> StateT World m [o]
forall a. a -> StateT World m a
forall (m :: * -> *) a. Monad m => a -> m a
return [o]
out