{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Aztecs.ECS.Query.Dynamic
-- Copyright   : (c) Matt Hunzinger, 2025
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : matt@hunzinger.me
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Aztecs.ECS.Query.Dynamic
  ( -- * Dynamic queries
    DynamicQuery,
    DynamicQueryT (..),

    -- ** Operations
    entityDyn,
    fetchDyn,
    fetchMaybeDyn,
    fetchMapDyn,
    fetchMapDynM,
    zipFetchMapDyn,
    zipFetchMapAccumDyn,
    zipFetchMapDynM,
    zipFetchMapAccumDynM,

    -- ** Filters
    withDyn,
    withoutDyn,

    -- ** Running
    queryDyn,
    singleDyn,
    singleMaybeDyn,
    queryEntitiesDyn,
    readQueryDyn,
    mapSingleDyn,
    mapSingleMaybeDyn,
    readQueryEntitiesDyn,

    -- *** Internal
    QueryFilter (..),
    queryFilter,
    runDynQuery,
    runDynQueryEntities,
    readDynQuery,
    readDynQueryEntities,
  )
where

import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.World.Archetype (Archetype)
import qualified Aztecs.ECS.World.Archetype as A
import Aztecs.ECS.World.Archetypes (ArchetypeID, Node (..))
import qualified Aztecs.ECS.World.Archetypes as AS
import Aztecs.ECS.World.Entities
import Control.Applicative
import Control.Monad
import Control.Monad.Identity (Identity)
import Data.Bifunctor
import Data.Foldable
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Stack
import Prelude hiding (reads)

data Operation f a where
  Entity :: Operation f EntityID
  Fetch :: (Component a) => !ComponentID -> Operation f a
  FetchMaybe :: (Component a) => !ComponentID -> Operation f (Maybe a)
  FetchMap :: (Component a) => !(a -> a) -> !ComponentID -> Operation f a
  FetchMapM :: (Monad f, Component a) => !(a -> f a) -> !ComponentID -> Operation f a
  Adjust :: (Component a) => !(b -> a -> (c, a)) -> !ComponentID -> !(DynamicQueryT f b) -> Operation f (c, a)
  AdjustM :: (Monad f, Component a) => !(b -> a -> f (c, a)) -> !ComponentID -> !(DynamicQueryT f b) -> Operation f (c, a)
  With :: !ComponentID -> Operation f ()
  Without :: !ComponentID -> Operation f ()

-- @since 0.9
type DynamicQuery = DynamicQueryT Identity

-- | Dynamic query for components by ID.
--
-- @since 0.11
data DynamicQueryT f a where
  Pure :: !a -> DynamicQueryT f a
  Map :: !(a -> b) -> !(DynamicQueryT f a) -> DynamicQueryT f b
  Ap :: !(DynamicQueryT f (a -> b)) -> !(DynamicQueryT f a) -> DynamicQueryT f b
  Op :: !(Operation f a) -> DynamicQueryT f a

instance Functor (DynamicQueryT f) where
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
fmap = (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
forall a b (f :: * -> *).
(a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
Map

-- | @since 0.11
instance Applicative (DynamicQueryT f) where
  {-# INLINE pure #-}
  pure :: forall a. a -> DynamicQueryT f a
pure = a -> DynamicQueryT f a
forall a (f :: * -> *). a -> DynamicQueryT f a
Pure

  {-# INLINE (<*>) #-}
  <*> :: forall a b.
DynamicQueryT f (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
(<*>) = DynamicQueryT f (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
forall (f :: * -> *) a b.
DynamicQueryT f (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
Ap

{-# INLINE entityDyn #-}
entityDyn :: DynamicQueryT f EntityID
entityDyn :: forall (f :: * -> *). DynamicQueryT f EntityID
entityDyn = Operation f EntityID -> DynamicQueryT f EntityID
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op Operation f EntityID
forall (f :: * -> *). Operation f EntityID
Entity

{-# INLINE fetchDyn #-}
fetchDyn :: (Component a) => ComponentID -> DynamicQueryT f a
fetchDyn :: forall a (f :: * -> *).
Component a =>
ComponentID -> DynamicQueryT f a
fetchDyn = Operation f a -> DynamicQueryT f a
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op (Operation f a -> DynamicQueryT f a)
-> (ComponentID -> Operation f a)
-> ComponentID
-> DynamicQueryT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch

{-# INLINE fetchMaybeDyn #-}
fetchMaybeDyn :: (Component a) => ComponentID -> DynamicQueryT f (Maybe a)
fetchMaybeDyn :: forall a (f :: * -> *).
Component a =>
ComponentID -> DynamicQueryT f (Maybe a)
fetchMaybeDyn = Operation f (Maybe a) -> DynamicQueryT f (Maybe a)
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op (Operation f (Maybe a) -> DynamicQueryT f (Maybe a))
-> (ComponentID -> Operation f (Maybe a))
-> ComponentID
-> DynamicQueryT f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentID -> Operation f (Maybe a)
forall a (f :: * -> *).
Component a =>
ComponentID -> Operation f (Maybe a)
FetchMaybe

{-# INLINE fetchMapDyn #-}
fetchMapDyn :: (Component a) => (a -> a) -> ComponentID -> DynamicQueryT f a
fetchMapDyn :: forall a (f :: * -> *).
Component a =>
(a -> a) -> ComponentID -> DynamicQueryT f a
fetchMapDyn a -> a
f = Operation f a -> DynamicQueryT f a
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op (Operation f a -> DynamicQueryT f a)
-> (ComponentID -> Operation f a)
-> ComponentID
-> DynamicQueryT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> ComponentID -> Operation f a
forall a (f :: * -> *).
Component a =>
(a -> a) -> ComponentID -> Operation f a
FetchMap a -> a
f

{-# INLINE fetchMapDynM #-}
fetchMapDynM :: (Monad f, Component a) => (a -> f a) -> ComponentID -> DynamicQueryT f a
fetchMapDynM :: forall (f :: * -> *) a.
(Monad f, Component a) =>
(a -> f a) -> ComponentID -> DynamicQueryT f a
fetchMapDynM a -> f a
f = Operation f a -> DynamicQueryT f a
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op (Operation f a -> DynamicQueryT f a)
-> (ComponentID -> Operation f a)
-> ComponentID
-> DynamicQueryT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> ComponentID -> Operation f a
forall (f :: * -> *) a.
(Monad f, Component a) =>
(a -> f a) -> ComponentID -> Operation f a
FetchMapM a -> f a
f

{-# INLINE zipFetchMapDyn #-}
zipFetchMapDyn :: (Component a) => (b -> a -> a) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
zipFetchMapDyn :: forall a b (f :: * -> *).
Component a =>
(b -> a -> a)
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
zipFetchMapDyn b -> a -> a
f ComponentID
cId DynamicQueryT f b
q = ((), a) -> a
forall a b. (a, b) -> b
snd (((), a) -> a) -> DynamicQueryT f ((), a) -> DynamicQueryT f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Operation f ((), a) -> DynamicQueryT f ((), a)
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op ((b -> a -> ((), a))
-> ComponentID -> DynamicQueryT f b -> Operation f ((), a)
forall a b c (f :: * -> *).
Component a =>
(b -> a -> (c, a))
-> ComponentID -> DynamicQueryT f b -> Operation f (c, a)
Adjust (\b
b a
a -> ((), b -> a -> a
f b
b a
a)) ComponentID
cId DynamicQueryT f b
q)

{-# INLINE zipFetchMapAccumDyn #-}
zipFetchMapAccumDyn :: (Component a) => (b -> a -> (c, a)) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f (c, a)
zipFetchMapAccumDyn :: forall a b c (f :: * -> *).
Component a =>
(b -> a -> (c, a))
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f (c, a)
zipFetchMapAccumDyn b -> a -> (c, a)
f ComponentID
cId DynamicQueryT f b
q = Operation f (c, a) -> DynamicQueryT f (c, a)
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op (Operation f (c, a) -> DynamicQueryT f (c, a))
-> Operation f (c, a) -> DynamicQueryT f (c, a)
forall a b. (a -> b) -> a -> b
$ (b -> a -> (c, a))
-> ComponentID -> DynamicQueryT f b -> Operation f (c, a)
forall a b c (f :: * -> *).
Component a =>
(b -> a -> (c, a))
-> ComponentID -> DynamicQueryT f b -> Operation f (c, a)
Adjust b -> a -> (c, a)
f ComponentID
cId DynamicQueryT f b
q

{-# INLINE zipFetchMapDynM #-}
zipFetchMapDynM :: (Monad f, Component a) => (b -> a -> f a) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
zipFetchMapDynM :: forall (f :: * -> *) a b.
(Monad f, Component a) =>
(b -> a -> f a)
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
zipFetchMapDynM b -> a -> f a
f ComponentID
cId DynamicQueryT f b
q = ((), a) -> a
forall a b. (a, b) -> b
snd (((), a) -> a) -> DynamicQueryT f ((), a) -> DynamicQueryT f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> a -> f ((), a))
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f ((), a)
forall (f :: * -> *) a b c.
(Monad f, Component a) =>
(b -> a -> f (c, a))
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f (c, a)
zipFetchMapAccumDynM (\b
b a
a -> ((),) (a -> ((), a)) -> f a -> f ((), a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> a -> f a
f b
b a
a) ComponentID
cId DynamicQueryT f b
q

{-# INLINE zipFetchMapAccumDynM #-}
zipFetchMapAccumDynM :: (Monad f, Component a) => (b -> a -> f (c, a)) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f (c, a)
zipFetchMapAccumDynM :: forall (f :: * -> *) a b c.
(Monad f, Component a) =>
(b -> a -> f (c, a))
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f (c, a)
zipFetchMapAccumDynM b -> a -> f (c, a)
f ComponentID
cId DynamicQueryT f b
q = Operation f (c, a) -> DynamicQueryT f (c, a)
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op (Operation f (c, a) -> DynamicQueryT f (c, a))
-> Operation f (c, a) -> DynamicQueryT f (c, a)
forall a b. (a -> b) -> a -> b
$ (b -> a -> f (c, a))
-> ComponentID -> DynamicQueryT f b -> Operation f (c, a)
forall (f :: * -> *) a b c.
(Monad f, Component a) =>
(b -> a -> f (c, a))
-> ComponentID -> DynamicQueryT f b -> Operation f (c, a)
AdjustM b -> a -> f (c, a)
f ComponentID
cId DynamicQueryT f b
q

{-# INLINE withDyn #-}
withDyn :: ComponentID -> DynamicQueryT f ()
withDyn :: forall (f :: * -> *). ComponentID -> DynamicQueryT f ()
withDyn = Operation f () -> DynamicQueryT f ()
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op (Operation f () -> DynamicQueryT f ())
-> (ComponentID -> Operation f ())
-> ComponentID
-> DynamicQueryT f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentID -> Operation f ()
forall (f :: * -> *). ComponentID -> Operation f ()
With

{-# INLINE withoutDyn #-}
withoutDyn :: ComponentID -> DynamicQueryT f ()
withoutDyn :: forall (f :: * -> *). ComponentID -> DynamicQueryT f ()
withoutDyn = Operation f () -> DynamicQueryT f ()
forall (f :: * -> *) a. Operation f a -> DynamicQueryT f a
Op (Operation f () -> DynamicQueryT f ())
-> (ComponentID -> Operation f ())
-> ComponentID
-> DynamicQueryT f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentID -> Operation f ()
forall (f :: * -> *). ComponentID -> Operation f ()
Without

{-# INLINE opFilter #-}
opFilter :: Operation f a -> QueryFilter
opFilter :: forall (f :: * -> *) a. Operation f a -> QueryFilter
opFilter Operation f a
Entity = QueryFilter
forall a. Monoid a => a
mempty
opFilter (Fetch ComponentID
cId) = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter (FetchMaybe ComponentID
cId) = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter (FetchMap a -> a
_ ComponentID
cId) = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter (FetchMapM a -> f a
_ ComponentID
cId) = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter (Adjust b -> a -> (c, a)
_ ComponentID
cId DynamicQueryT f b
q) = DynamicQueryT f b -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f b
q QueryFilter -> QueryFilter -> QueryFilter
forall a. Semigroup a => a -> a -> a
<> QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter (AdjustM b -> a -> f (c, a)
_ ComponentID
cId DynamicQueryT f b
q) = DynamicQueryT f b -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f b
q QueryFilter -> QueryFilter -> QueryFilter
forall a. Semigroup a => a -> a -> a
<> QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter (With ComponentID
cId) = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter (Without ComponentID
cId) = QueryFilter
forall a. Monoid a => a
mempty {filterWithout = Set.singleton cId}

{-# INLINE queryFilter #-}
queryFilter :: DynamicQueryT f a -> QueryFilter
queryFilter :: forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter (Pure a
_) = QueryFilter
forall a. Monoid a => a
mempty
queryFilter (Map a -> a
_ DynamicQueryT f a
q) = DynamicQueryT f a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f a
q
queryFilter (Ap DynamicQueryT f (a -> a)
f DynamicQueryT f a
g) = DynamicQueryT f (a -> a) -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f (a -> a)
f QueryFilter -> QueryFilter -> QueryFilter
forall a. Semigroup a => a -> a -> a
<> DynamicQueryT f a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f a
g
queryFilter (Op Operation f a
op) = Operation f a -> QueryFilter
forall (f :: * -> *) a. Operation f a -> QueryFilter
opFilter Operation f a
op

{-# INLINE runOp #-}
runOp :: (Applicative f) => Operation f a -> Archetype -> f ([a], Archetype)
runOp :: forall (f :: * -> *) a.
Applicative f =>
Operation f a -> Archetype -> f ([a], Archetype)
runOp Operation f a
Entity Archetype
arch = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> [EntityID]) -> Set EntityID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Archetype -> Set EntityID
A.entities Archetype
arch, Archetype
forall a. Monoid a => a
mempty)
runOp (Fetch ComponentID
cId) Archetype
arch = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComponentID -> Archetype -> [a]
forall a. Component a => ComponentID -> Archetype -> [a]
A.lookupComponentsAsc ComponentID
cId Archetype
arch, Archetype
forall a. Monoid a => a
mempty)
runOp (FetchMaybe ComponentID
cId) Archetype
arch =
  ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( case ComponentID -> Archetype -> Maybe [a]
forall a. Component a => ComponentID -> Archetype -> Maybe [a]
A.lookupComponentsAscMaybe ComponentID
cId Archetype
arch of
        Just [a]
as -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
a -> Maybe a
forall a. a -> Maybe a
Just [a]
as
        Maybe [a]
Nothing -> Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Set EntityID -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set EntityID -> Int) -> Set EntityID -> Int
forall a b. (a -> b) -> a -> b
$ Archetype -> Set EntityID
A.entities Archetype
arch) a
Maybe a
forall a. Maybe a
Nothing,
      Archetype
forall a. Monoid a => a
mempty
    )
runOp (FetchMap a -> a
f ComponentID
cId) Archetype
arch = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([a], Archetype) -> f ([a], Archetype))
-> ([a], Archetype) -> f ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ (a -> a) -> ComponentID -> Archetype -> ([a], Archetype)
forall a.
Component a =>
(a -> a) -> ComponentID -> Archetype -> ([a], Archetype)
A.map a -> a
f ComponentID
cId Archetype
arch
runOp (FetchMapM a -> f a
f ComponentID
cId) Archetype
arch = do
  ([a]
as, Archetype
arch') <- (a -> f a) -> ComponentID -> Archetype -> f ([a], Archetype)
forall (m :: * -> *) a.
(Monad m, Component a) =>
(a -> m a) -> ComponentID -> Archetype -> m ([a], Archetype)
A.mapM a -> f a
f ComponentID
cId Archetype
arch
  ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
as, Archetype
arch')
runOp (Adjust b -> a -> (c, a)
f ComponentID
cId DynamicQueryT f b
q) Archetype
arch = do
  ([b], Archetype)
res <- DynamicQueryT f b -> Archetype -> f ([b], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT f b
q Archetype
arch
  return $
    let !([b]
bs, Archetype
arch') = ([b], Archetype)
res
        !([(c, a)]
as, Archetype
arch'') = [b]
-> (b -> a -> (c, a))
-> ComponentID
-> Archetype
-> ([(c, a)], Archetype)
forall a b c.
Component c =>
[a]
-> (a -> c -> (b, c))
-> ComponentID
-> Archetype
-> ([(b, c)], Archetype)
A.zipWith [b]
bs b -> a -> (c, a)
f ComponentID
cId Archetype
arch
     in ([a]
[(c, a)]
as, Archetype
arch'' Archetype -> Archetype -> Archetype
forall a. Semigroup a => a -> a -> a
<> Archetype
arch')
runOp (AdjustM b -> a -> f (c, a)
f ComponentID
cId DynamicQueryT f b
q) Archetype
arch = do
  ([b]
as, Archetype
arch') <- DynamicQueryT f b -> Archetype -> f ([b], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT f b
q Archetype
arch
  ([(c, a)]
bs, Archetype
arch'') <- [b]
-> (b -> a -> f (c, a))
-> ComponentID
-> Archetype
-> f ([(c, a)], Archetype)
forall (m :: * -> *) a b c.
(Applicative m, Component c) =>
[a]
-> (a -> c -> m (b, c))
-> ComponentID
-> Archetype
-> m ([(b, c)], Archetype)
A.zipWithM [b]
as b -> a -> f (c, a)
f ComponentID
cId Archetype
arch
  ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
[(c, a)]
bs, Archetype
arch'' Archetype -> Archetype -> Archetype
forall a. Semigroup a => a -> a -> a
<> Archetype
arch')
runOp (With ComponentID
_) Archetype
_ = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Archetype
forall a. Monoid a => a
mempty)
runOp (Without ComponentID
_) Archetype
_ = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Archetype
forall a. Monoid a => a
mempty)

{-# INLINE readOp #-}
readOp :: (Applicative f) => Operation f a -> Archetype -> f [a]
readOp :: forall (f :: * -> *) a.
Applicative f =>
Operation f a -> Archetype -> f [a]
readOp Operation f a
Entity Archetype
arch = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> f [a]) -> [a] -> f [a]
forall a b. (a -> b) -> a -> b
$ Set EntityID -> [EntityID]
forall a. Set a -> [a]
Set.toList (Set EntityID -> [EntityID]) -> Set EntityID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Archetype -> Set EntityID
A.entities Archetype
arch
readOp (Fetch ComponentID
cId) Archetype
arch = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> f [a]) -> [a] -> f [a]
forall a b. (a -> b) -> a -> b
$ ComponentID -> Archetype -> [a]
forall a. Component a => ComponentID -> Archetype -> [a]
A.lookupComponentsAsc ComponentID
cId Archetype
arch
readOp (FetchMaybe ComponentID
cId) Archetype
arch =
  [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> f [a]) -> [a] -> f [a]
forall a b. (a -> b) -> a -> b
$
    case ComponentID -> Archetype -> Maybe [a]
forall a. Component a => ComponentID -> Archetype -> Maybe [a]
A.lookupComponentsAscMaybe ComponentID
cId Archetype
arch of
      Just [a]
as -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
a -> Maybe a
forall a. a -> Maybe a
Just [a]
as
      Maybe [a]
Nothing -> Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Set EntityID -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set EntityID -> Int) -> Set EntityID -> Int
forall a b. (a -> b) -> a -> b
$ Archetype -> Set EntityID
A.entities Archetype
arch) a
Maybe a
forall a. Maybe a
Nothing
readOp (FetchMap a -> a
f ComponentID
cId) Archetype
arch = do
  [a]
bs <- Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> Archetype -> f [a]
readOp (ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch ComponentID
cId) Archetype
arch
  return $ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
bs
readOp (FetchMapM a -> f a
f ComponentID
cId) Archetype
arch = do
  [a]
bs <- Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> Archetype -> f [a]
readOp (ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch ComponentID
cId) Archetype
arch
  (a -> f a) -> [a] -> f [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> f a
f [a]
bs
readOp (Adjust b -> a -> (c, a)
f ComponentID
cId DynamicQueryT f b
q) Archetype
arch = do
  [b]
as <- DynamicQueryT f b -> Archetype -> f [b]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f b
q Archetype
arch
  [a]
bs <- Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> Archetype -> f [a]
readOp (ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch ComponentID
cId) Archetype
arch
  return $ (b -> a -> a) -> [b] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith b -> a -> a
b -> a -> (c, a)
f [b]
as [a]
bs
readOp (AdjustM b -> a -> f (c, a)
f ComponentID
cId DynamicQueryT f b
q) Archetype
arch = do
  [b]
as <- DynamicQueryT f b -> Archetype -> f [b]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f b
q Archetype
arch
  [a]
bs <- Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> Archetype -> f [a]
readOp (ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch ComponentID
cId) Archetype
arch
  (b -> a -> f a) -> [b] -> [a] -> f [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM b -> a -> f a
b -> a -> f (c, a)
f [b]
as [a]
bs
readOp (With ComponentID
_) Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
readOp (Without ComponentID
_) Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

{-# INLINE queryEntitiesDyn #-}
queryEntitiesDyn ::
  (Monad m) =>
  [EntityID] ->
  DynamicQueryT m a ->
  Entities ->
  m ([a], Entities)
queryEntitiesDyn :: forall (m :: * -> *) a.
Monad m =>
[EntityID] -> DynamicQueryT m a -> Entities -> m ([a], Entities)
queryEntitiesDyn [EntityID]
eIds DynamicQueryT m a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
      go :: Archetype -> m ([a], Archetype)
go = [EntityID] -> DynamicQueryT m a -> Archetype -> m ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQueryEntities [EntityID]
eIds DynamicQueryT m a
q
   in if Set ComponentID -> Bool
forall a. Set a -> Bool
Set.null (Set ComponentID -> Bool) -> Set ComponentID -> Bool
forall a b. (a -> b) -> a -> b
$ QueryFilter -> Set ComponentID
filterWith QueryFilter
qf
        then do
          ([a]
as, Archetype
_) <- Archetype -> m ([a], Archetype)
go Archetype
A.empty {A.entities = Map.keysSet $ entities es}
          ([a], Entities) -> m ([a], Entities)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
as, Entities
es)
        else
          let go' :: ([a], Entities) -> (ArchetypeID, Node) -> m ([a], Entities)
go' ([a]
acc, Entities
esAcc) (ArchetypeID
aId, Node
n) = do
                ([a]
as', Archetype
arch') <- Archetype -> m ([a], Archetype)
go (Archetype -> m ([a], Archetype))
-> Archetype -> m ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n
                let n' :: Node
n' = Node
n {nodeArchetype = arch' <> nodeArchetype n}
                    !nodes :: Map ArchetypeID Node
nodes = ArchetypeID -> Node -> Map ArchetypeID Node -> Map ArchetypeID Node
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId Node
n' (Map ArchetypeID Node -> Map ArchetypeID Node)
-> (Archetypes -> Map ArchetypeID Node)
-> Archetypes
-> Map ArchetypeID Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archetypes -> Map ArchetypeID Node
AS.nodes (Archetypes -> Map ArchetypeID Node)
-> Archetypes -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
esAcc
                ([a], Entities) -> m ([a], Entities)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
return ([a]
as' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc, Entities
esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}})
           in (([a], Entities) -> (ArchetypeID, Node) -> m ([a], Entities))
-> ([a], Entities) -> [(ArchetypeID, Node)] -> m ([a], Entities)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ([a], Entities) -> (ArchetypeID, Node) -> m ([a], Entities)
go' ([], Entities
es) ([(ArchetypeID, Node)] -> m ([a], Entities))
-> [(ArchetypeID, Node)] -> m ([a], Entities)
forall a b. (a -> b) -> a -> b
$ Map ArchetypeID Node -> [(ArchetypeID, Node)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ArchetypeID Node -> [(ArchetypeID, Node)])
-> (Archetypes -> Map ArchetypeID Node)
-> Archetypes
-> [(ArchetypeID, Node)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ComponentID
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find (QueryFilter -> Set ComponentID
filterWith QueryFilter
qf) (QueryFilter -> Set ComponentID
filterWithout QueryFilter
qf) (Archetypes -> [(ArchetypeID, Node)])
-> Archetypes -> [(ArchetypeID, Node)]
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
es

readQueryEntitiesDyn :: (Monad m) => [EntityID] -> DynamicQueryT m a -> Entities -> m [a]
readQueryEntitiesDyn :: forall (m :: * -> *) a.
Monad m =>
[EntityID] -> DynamicQueryT m a -> Entities -> m [a]
readQueryEntitiesDyn [EntityID]
eIds DynamicQueryT m a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
   in if Set ComponentID -> Bool
forall a. Set a -> Bool
Set.null (Set ComponentID -> Bool) -> Set ComponentID -> Bool
forall a b. (a -> b) -> a -> b
$ QueryFilter -> Set ComponentID
filterWith QueryFilter
qf
        then [EntityID] -> DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
eIds DynamicQueryT m a
q Archetype
A.empty {A.entities = Map.keysSet $ entities es}
        else
          let go :: Node -> m [a]
go Node
n = DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT m a
q (Archetype -> m [a]) -> Archetype -> m [a]
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
AS.nodeArchetype Node
n
           in Map ArchetypeID [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Map ArchetypeID [a] -> [a]) -> m (Map ArchetypeID [a]) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node -> m [a]) -> Map ArchetypeID Node -> m (Map ArchetypeID [a])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map ArchetypeID a -> m (Map ArchetypeID b)
mapM Node -> m [a]
go (Set ComponentID
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find (QueryFilter -> Set ComponentID
filterWith QueryFilter
qf) (QueryFilter -> Set ComponentID
filterWithout QueryFilter
qf) (Archetypes -> Map ArchetypeID Node)
-> Archetypes -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
es)

runOpEntities :: (Applicative f) => Operation f a -> [EntityID] -> Archetype -> f ([a], Archetype)
runOpEntities :: forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f ([a], Archetype)
runOpEntities Operation f a
Entity [EntityID]
es Archetype
_ = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
[EntityID]
es, Archetype
forall a. Monoid a => a
mempty)
runOpEntities (Fetch ComponentID
cId) [EntityID]
es Archetype
arch =
  ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( ((EntityID, a) -> a) -> [(EntityID, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (EntityID, a) -> a
forall a b. (a, b) -> b
snd
        ([(EntityID, a)] -> [a])
-> (Map EntityID a -> [(EntityID, a)]) -> Map EntityID a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EntityID, a) -> Bool) -> [(EntityID, a)] -> [(EntityID, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(EntityID
e, a
_) -> EntityID
e EntityID -> [EntityID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EntityID]
es)
        ([(EntityID, a)] -> [(EntityID, a)])
-> (Map EntityID a -> [(EntityID, a)])
-> Map EntityID a
-> [(EntityID, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map EntityID a -> [(EntityID, a)]
forall k a. Map k a -> [(k, a)]
Map.toList
        (Map EntityID a -> [a]) -> Map EntityID a -> [a]
forall a b. (a -> b) -> a -> b
$ ComponentID -> Archetype -> Map EntityID a
forall a. Component a => ComponentID -> Archetype -> Map EntityID a
A.lookupComponents ComponentID
cId Archetype
arch,
      Archetype
forall a. Monoid a => a
mempty
    )
runOpEntities (FetchMaybe ComponentID
cId) [EntityID]
es Archetype
arch =
  ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( ((EntityID, a) -> a) -> [(EntityID, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\(EntityID
e, a
a) -> if EntityID
e EntityID -> [EntityID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EntityID]
es then a -> Maybe a
forall a. a -> Maybe a
Just a
a else a
Maybe a
forall a. Maybe a
Nothing)
        ([(EntityID, a)] -> [a])
-> (Map EntityID a -> [(EntityID, a)]) -> Map EntityID a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map EntityID a -> [(EntityID, a)]
forall k a. Map k a -> [(k, a)]
Map.toList
        (Map EntityID a -> [a]) -> Map EntityID a -> [a]
forall a b. (a -> b) -> a -> b
$ ComponentID -> Archetype -> Map EntityID a
forall a. Component a => ComponentID -> Archetype -> Map EntityID a
A.lookupComponents ComponentID
cId Archetype
arch,
      Archetype
forall a. Monoid a => a
mempty
    )
runOpEntities (FetchMap a -> a
f ComponentID
cId) [EntityID]
es Archetype
arch =
  ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([a], Archetype) -> f ([a], Archetype))
-> ([a], Archetype) -> f ([a], Archetype)
forall a b. (a -> b) -> a -> b
$
    let go :: EntityID -> a -> (Maybe a, a)
go EntityID
e a
a =
          if EntityID
e EntityID -> [EntityID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EntityID]
es
            then let a' :: a
a' = a -> a
f a
a in (a -> Maybe a
forall a. a -> Maybe a
Just a
a', a
a')
            else (Maybe a
forall a. Maybe a
Nothing, a
a)
        !([(Maybe a, a)]
as, Archetype
arch') = [EntityID]
-> (EntityID -> a -> (Maybe a, a))
-> ComponentID
-> Archetype
-> ([(Maybe a, a)], Archetype)
forall a b c.
Component c =>
[a]
-> (a -> c -> (b, c))
-> ComponentID
-> Archetype
-> ([(b, c)], Archetype)
A.zipWith [EntityID]
es EntityID -> a -> (Maybe a, a)
go ComponentID
cId Archetype
arch
     in (((Maybe a, a) -> Maybe a) -> [(Maybe a, a)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe a, a) -> Maybe a
forall a b. (a, b) -> a
fst [(Maybe a, a)]
as, Archetype
arch')
runOpEntities (FetchMapM a -> f a
f ComponentID
cId) [EntityID]
es Archetype
arch = do
  ([(a, a)]
as, Archetype
arch') <- Operation f (a, a)
-> [EntityID] -> Archetype -> f ([(a, a)], Archetype)
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f ([a], Archetype)
runOpEntities ((() -> a -> f (a, a))
-> ComponentID -> DynamicQueryT f () -> Operation f (a, a)
forall (f :: * -> *) a b c.
(Monad f, Component a) =>
(b -> a -> f (c, a))
-> ComponentID -> DynamicQueryT f b -> Operation f (c, a)
AdjustM (\() a
a -> (,a
a) (a -> (a, a)) -> f a -> f (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a) ComponentID
cId (() -> DynamicQueryT f ()
forall a. a -> DynamicQueryT f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) [EntityID]
es Archetype
arch
  ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd [(a, a)]
as, Archetype
arch')
runOpEntities (Adjust b -> a -> (c, a)
f ComponentID
cId DynamicQueryT f b
q) [EntityID]
es Archetype
arch = do
  ([b], Archetype)
res <- DynamicQueryT f b -> Archetype -> f ([b], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT f b
q Archetype
arch
  return $
    let go :: (EntityID, b) -> a -> (Maybe c, a)
go (EntityID
e, b
b) a
a =
          if EntityID
e EntityID -> [EntityID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EntityID]
es
            then let (c
x, a
y) = b -> a -> (c, a)
f b
b a
a in (c -> Maybe c
forall a. a -> Maybe a
Just c
x, a
y)
            else (Maybe c
forall a. Maybe a
Nothing, a
a)
        !([b]
bs, Archetype
arch') = ([b], Archetype)
res
        !([(Maybe c, a)]
as, Archetype
arch'') = [(EntityID, b)]
-> ((EntityID, b) -> a -> (Maybe c, a))
-> ComponentID
-> Archetype
-> ([(Maybe c, a)], Archetype)
forall a b c.
Component c =>
[a]
-> (a -> c -> (b, c))
-> ComponentID
-> Archetype
-> ([(b, c)], Archetype)
A.zipWith ([EntityID] -> [b] -> [(EntityID, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [EntityID]
es [b]
bs) (EntityID, b) -> a -> (Maybe c, a)
go ComponentID
cId Archetype
arch
     in (((Maybe c, a) -> Maybe a) -> [(Maybe c, a)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Maybe c
m, a
b) -> (c -> a) -> Maybe c -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,a
b) Maybe c
m) [(Maybe c, a)]
as, Archetype
arch'' Archetype -> Archetype -> Archetype
forall a. Semigroup a => a -> a -> a
<> Archetype
arch')
runOpEntities (AdjustM b -> a -> f (c, a)
f ComponentID
cId DynamicQueryT f b
q) [EntityID]
es Archetype
arch = do
  ([b]
bs, Archetype
arch') <- DynamicQueryT f b -> Archetype -> f ([b], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT f b
q Archetype
arch
  let go :: (EntityID, b) -> a -> f (Maybe c, a)
go (EntityID
e, b
b) a
a =
        if EntityID
e EntityID -> [EntityID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EntityID]
es
          then do
            (c
x, a
y) <- b -> a -> f (c, a)
f b
b a
a
            (Maybe c, a) -> f (Maybe c, a)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Maybe c
forall a. a -> Maybe a
Just c
x, a
y)
          else (Maybe c, a) -> f (Maybe c, a)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe c
forall a. Maybe a
Nothing, a
a)
  ([(Maybe c, a)]
as, Archetype
arch'') <- [(EntityID, b)]
-> ((EntityID, b) -> a -> f (Maybe c, a))
-> ComponentID
-> Archetype
-> f ([(Maybe c, a)], Archetype)
forall (m :: * -> *) a b c.
(Applicative m, Component c) =>
[a]
-> (a -> c -> m (b, c))
-> ComponentID
-> Archetype
-> m ([(b, c)], Archetype)
A.zipWithM ([EntityID] -> [b] -> [(EntityID, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [EntityID]
es [b]
bs) (EntityID, b) -> a -> f (Maybe c, a)
go ComponentID
cId Archetype
arch
  ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (((Maybe c, a) -> Maybe a) -> [(Maybe c, a)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Maybe c
m, a
b) -> (c -> a) -> Maybe c -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,a
b) Maybe c
m) [(Maybe c, a)]
as, Archetype
arch'' Archetype -> Archetype -> Archetype
forall a. Semigroup a => a -> a -> a
<> Archetype
arch')
runOpEntities (With ComponentID
_) [EntityID]
_ Archetype
arch = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Archetype
arch)
runOpEntities (Without ComponentID
_) [EntityID]
_ Archetype
arch = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Archetype
arch)

runDynQueryEntities :: (Applicative f) => [EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQueryEntities :: forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQueryEntities [EntityID]
es (Pure a
a) Archetype
_ = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate ([EntityID] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EntityID]
es) a
a, Archetype
forall a. Monoid a => a
mempty)
runDynQueryEntities [EntityID]
es (Map a -> a
f DynamicQueryT f a
q) Archetype
arch = ([a] -> [a]) -> ([a], Archetype) -> ([a], Archetype)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f) (([a], Archetype) -> ([a], Archetype))
-> f ([a], Archetype) -> f ([a], Archetype)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQueryEntities [EntityID]
es DynamicQueryT f a
q Archetype
arch
runDynQueryEntities [EntityID]
es (Ap DynamicQueryT f (a -> a)
f DynamicQueryT f a
g) Archetype
arch = do
  ([a], Archetype)
res <- [EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQueryEntities [EntityID]
es DynamicQueryT f a
g Archetype
arch
  ([a -> a], Archetype)
res' <- [EntityID]
-> DynamicQueryT f (a -> a) -> Archetype -> f ([a -> a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQueryEntities [EntityID]
es DynamicQueryT f (a -> a)
f Archetype
arch
  return $
    let ([a]
as, Archetype
arch') = ([a], Archetype)
res
        ([a -> a]
bs, Archetype
arch'') = ([a -> a], Archetype)
res'
     in (((a -> a) -> a -> a) -> [a -> a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) [a -> a]
bs [a]
as, Archetype
arch'' Archetype -> Archetype -> Archetype
forall a. Semigroup a => a -> a -> a
<> Archetype
arch')
runDynQueryEntities [EntityID]
es (Op Operation f a
op) Archetype
arch = Operation f a -> [EntityID] -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f ([a], Archetype)
runOpEntities Operation f a
op [EntityID]
es Archetype
arch

{-# INLINE readOpEntities #-}
readOpEntities :: (Applicative f) => Operation f a -> [EntityID] -> Archetype -> f [a]
readOpEntities :: forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f [a]
readOpEntities Operation f a
Entity [EntityID]
es Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
[EntityID]
es
readOpEntities (Fetch ComponentID
cId) [EntityID]
es Archetype
arch =
  [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ([a] -> f [a])
-> (Map EntityID a -> [a]) -> Map EntityID a -> f [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EntityID, a) -> a) -> [(EntityID, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (EntityID, a) -> a
forall a b. (a, b) -> b
snd
    ([(EntityID, a)] -> [a])
-> (Map EntityID a -> [(EntityID, a)]) -> Map EntityID a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EntityID, a) -> Bool) -> [(EntityID, a)] -> [(EntityID, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(EntityID
e, a
_) -> EntityID
e EntityID -> [EntityID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EntityID]
es)
    ([(EntityID, a)] -> [(EntityID, a)])
-> (Map EntityID a -> [(EntityID, a)])
-> Map EntityID a
-> [(EntityID, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map EntityID a -> [(EntityID, a)]
forall k a. Map k a -> [(k, a)]
Map.toList
    (Map EntityID a -> f [a]) -> Map EntityID a -> f [a]
forall a b. (a -> b) -> a -> b
$ ComponentID -> Archetype -> Map EntityID a
forall a. Component a => ComponentID -> Archetype -> Map EntityID a
A.lookupComponents ComponentID
cId Archetype
arch
readOpEntities (FetchMaybe ComponentID
cId) [EntityID]
es Archetype
arch =
  [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ([a] -> f [a])
-> (Map EntityID a -> [a]) -> Map EntityID a -> f [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EntityID, a) -> a) -> [(EntityID, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\(EntityID
e, a
a) -> if EntityID
e EntityID -> [EntityID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EntityID]
es then a -> Maybe a
forall a. a -> Maybe a
Just a
a else a
Maybe a
forall a. Maybe a
Nothing)
    ([(EntityID, a)] -> [a])
-> (Map EntityID a -> [(EntityID, a)]) -> Map EntityID a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map EntityID a -> [(EntityID, a)]
forall k a. Map k a -> [(k, a)]
Map.toList
    (Map EntityID a -> f [a]) -> Map EntityID a -> f [a]
forall a b. (a -> b) -> a -> b
$ ComponentID -> Archetype -> Map EntityID a
forall a. Component a => ComponentID -> Archetype -> Map EntityID a
A.lookupComponents ComponentID
cId Archetype
arch
readOpEntities (FetchMap a -> a
f ComponentID
cId) [EntityID]
es Archetype
arch = do
  [a]
b <- Operation f a -> [EntityID] -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f [a]
readOpEntities (ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch ComponentID
cId) [EntityID]
es Archetype
arch
  pure $ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
b
readOpEntities (FetchMapM a -> f a
f ComponentID
cId) [EntityID]
es Archetype
arch = do
  [a]
b <- Operation f a -> [EntityID] -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f [a]
readOpEntities (ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch ComponentID
cId) [EntityID]
es Archetype
arch
  (a -> f a) -> [a] -> f [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> f a
f [a]
b
readOpEntities (Adjust b -> a -> (c, a)
f ComponentID
cId DynamicQueryT f b
q) [EntityID]
es Archetype
arch = do
  [b]
a <- [EntityID] -> DynamicQueryT f b -> Archetype -> f [b]
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
es DynamicQueryT f b
q Archetype
arch
  [a]
b <- Operation f a -> [EntityID] -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f [a]
readOpEntities (ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch ComponentID
cId) [EntityID]
es Archetype
arch
  pure $ (b -> a -> a) -> [b] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith b -> a -> a
b -> a -> (c, a)
f [b]
a [a]
b
readOpEntities (AdjustM b -> a -> f (c, a)
f ComponentID
cId DynamicQueryT f b
q) [EntityID]
es Archetype
arch = do
  [b]
a <- [EntityID] -> DynamicQueryT f b -> Archetype -> f [b]
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
es DynamicQueryT f b
q Archetype
arch
  [a]
b <- Operation f a -> [EntityID] -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f [a]
readOpEntities (ComponentID -> Operation f a
forall a (f :: * -> *). Component a => ComponentID -> Operation f a
Fetch ComponentID
cId) [EntityID]
es Archetype
arch
  (b -> a -> f a) -> [b] -> [a] -> f [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM b -> a -> f a
b -> a -> f (c, a)
f [b]
a [a]
b
readOpEntities (With ComponentID
_) [EntityID]
_ Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
readOpEntities (Without ComponentID
_) [EntityID]
_ Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

{-# INLINE readDynQueryEntities #-}
readDynQueryEntities :: (Applicative f) => [EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities :: forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
es (Pure a
a) Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> f [a]) -> [a] -> f [a]
forall a b. (a -> b) -> a -> b
$ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate ([EntityID] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EntityID]
es) a
a
readDynQueryEntities [EntityID]
es (Map a -> a
f DynamicQueryT f a
q) Archetype
arch = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
es DynamicQueryT f a
q Archetype
arch
readDynQueryEntities [EntityID]
es (Ap DynamicQueryT f (a -> a)
f DynamicQueryT f a
g) Archetype
arch = do
  [a]
a <- [EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
es DynamicQueryT f a
g Archetype
arch
  [a -> a]
b <- [EntityID] -> DynamicQueryT f (a -> a) -> Archetype -> f [a -> a]
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
es DynamicQueryT f (a -> a)
f Archetype
arch
  pure $ [a -> a]
b [a -> a] -> [a] -> [a]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a]
a
readDynQueryEntities [EntityID]
es (Op Operation f a
op) Archetype
arch = Operation f a -> [EntityID] -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> [EntityID] -> Archetype -> f [a]
readOpEntities Operation f a
op [EntityID]
es Archetype
arch

{-# INLINE runDynQuery #-}
runDynQuery :: (Applicative f) => DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery :: forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery (Pure a
a) Archetype
arch = ([a], Archetype) -> f ([a], Archetype)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Set EntityID -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set EntityID -> Int) -> Set EntityID -> Int
forall a b. (a -> b) -> a -> b
$ Archetype -> Set EntityID
A.entities Archetype
arch) a
a, Archetype
forall a. Monoid a => a
mempty)
runDynQuery (Map a -> a
f DynamicQueryT f a
q) Archetype
arch = do
  ([a], Archetype)
res <- DynamicQueryT f a -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT f a
q Archetype
arch
  return $ ([a] -> [a]) -> ([a], Archetype) -> ([a], Archetype)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f) ([a], Archetype)
res
runDynQuery (Ap DynamicQueryT f (a -> a)
f DynamicQueryT f a
g) Archetype
arch = do
  ([a], Archetype)
res <- DynamicQueryT f a -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT f a
g Archetype
arch
  ([a -> a], Archetype)
res' <- DynamicQueryT f (a -> a) -> Archetype -> f ([a -> a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT f (a -> a)
f Archetype
arch
  return $
    let ([a]
as, Archetype
arch') = ([a], Archetype)
res
        ([a -> a]
bs, Archetype
arch'') = ([a -> a], Archetype)
res'
     in (((a -> a) -> a -> a) -> [a -> a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) [a -> a]
bs [a]
as, Archetype
arch'' Archetype -> Archetype -> Archetype
forall a. Semigroup a => a -> a -> a
<> Archetype
arch')
runDynQuery (Op Operation f a
op) Archetype
arch = Operation f a -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> Archetype -> f ([a], Archetype)
runOp Operation f a
op Archetype
arch

{-# INLINE readDynQuery #-}
readDynQuery :: (Applicative f) => DynamicQueryT f a -> Archetype -> f [a]
readDynQuery :: forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery (Pure a
a) Archetype
arch = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> f [a]) -> [a] -> f [a]
forall a b. (a -> b) -> a -> b
$ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Set EntityID -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set EntityID -> Int) -> Set EntityID -> Int
forall a b. (a -> b) -> a -> b
$ Archetype -> Set EntityID
A.entities Archetype
arch) a
a
readDynQuery (Map a -> a
f DynamicQueryT f a
q) Archetype
arch = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicQueryT f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f a
q Archetype
arch
readDynQuery (Ap DynamicQueryT f (a -> a)
f DynamicQueryT f a
g) Archetype
arch = do
  [a]
as <- DynamicQueryT f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f a
g Archetype
arch
  [a -> a]
bs <- DynamicQueryT f (a -> a) -> Archetype -> f [a -> a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f (a -> a)
f Archetype
arch
  pure $ ((a -> a) -> a -> a) -> [a -> a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) [a -> a]
bs [a]
as
readDynQuery (Op Operation f a
op) Archetype
arch = Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
Operation f a -> Archetype -> f [a]
readOp Operation f a
op Archetype
arch

-- | Match all entities.
--
-- @since 0.11
readQueryDyn :: (Monad m) => DynamicQueryT m a -> Entities -> m [a]
readQueryDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> Entities -> m [a]
readQueryDyn DynamicQueryT m a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
   in if Set ComponentID -> Bool
forall a. Set a -> Bool
Set.null (Set ComponentID -> Bool) -> Set ComponentID -> Bool
forall a b. (a -> b) -> a -> b
$ QueryFilter -> Set ComponentID
filterWith QueryFilter
qf
        then DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT m a
q (Archetype -> m [a]) -> Archetype -> m [a]
forall a b. (a -> b) -> a -> b
$ Archetype
A.empty {A.entities = Map.keysSet $ entities es}
        else
          let go :: Node -> m [a]
go Node
n = DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT m a
q (Archetype -> m [a]) -> Archetype -> m [a]
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
AS.nodeArchetype Node
n
           in Map ArchetypeID [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Map ArchetypeID [a] -> [a]) -> m (Map ArchetypeID [a]) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node -> m [a]) -> Map ArchetypeID Node -> m (Map ArchetypeID [a])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map ArchetypeID a -> m (Map ArchetypeID b)
mapM Node -> m [a]
go (Set ComponentID
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find (QueryFilter -> Set ComponentID
filterWith QueryFilter
qf) (QueryFilter -> Set ComponentID
filterWithout QueryFilter
qf) (Archetypes -> Map ArchetypeID Node)
-> Archetypes -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
es)

-- | Match a single entity.
--
-- @since 0.11
singleDyn :: (HasCallStack, Monad m) => DynamicQueryT m a -> Entities -> m a
singleDyn :: forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
DynamicQueryT m a -> Entities -> m a
singleDyn DynamicQueryT m a
q Entities
es = do
  Maybe a
res <- DynamicQueryT m a -> Entities -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> Entities -> m (Maybe a)
singleMaybeDyn DynamicQueryT m a
q Entities
es
  return $ case Maybe a
res of
    Just a
a -> a
a
    Maybe a
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"singleDyn: expected a single entity"

-- | Match a single entity, or `Nothing`.
--
-- @since 0.11
singleMaybeDyn :: (Monad m) => DynamicQueryT m a -> Entities -> m (Maybe a)
singleMaybeDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> Entities -> m (Maybe a)
singleMaybeDyn DynamicQueryT m a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
   in if Set ComponentID -> Bool
forall a. Set a -> Bool
Set.null (Set ComponentID -> Bool) -> Set ComponentID -> Bool
forall a b. (a -> b) -> a -> b
$ QueryFilter -> Set ComponentID
filterWith QueryFilter
qf
        then case Map EntityID ArchetypeID -> [EntityID]
forall k a. Map k a -> [k]
Map.keys (Map EntityID ArchetypeID -> [EntityID])
-> Map EntityID ArchetypeID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Entities -> Map EntityID ArchetypeID
entities Entities
es of
          [EntityID
eId] -> do
            [a]
res <- DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT m a
q (Archetype -> m [a]) -> Archetype -> m [a]
forall a b. (a -> b) -> a -> b
$ EntityID -> Archetype
A.singleton EntityID
eId
            return $ case [a]
res of
              [a
a] -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
              [a]
_ -> Maybe a
forall a. Maybe a
Nothing
          [EntityID]
_ -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        else case Map ArchetypeID Node -> [Node]
forall k a. Map k a -> [a]
Map.elems (Map ArchetypeID Node -> [Node]) -> Map ArchetypeID Node -> [Node]
forall a b. (a -> b) -> a -> b
$ Set ComponentID
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find (QueryFilter -> Set ComponentID
filterWith QueryFilter
qf) (QueryFilter -> Set ComponentID
filterWithout QueryFilter
qf) (Archetypes -> Map ArchetypeID Node)
-> Archetypes -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
es of
          [Node
n] -> do
            [a]
res <- DynamicQueryT m a -> Archetype -> m [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT m a
q (Archetype -> m [a]) -> Archetype -> m [a]
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
AS.nodeArchetype Node
n
            return $ case [a]
res of
              [a
a] -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
              [a]
_ -> Maybe a
forall a. Maybe a
Nothing
          [Node]
_ -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | Match and update all matched entities.
--
-- @since 0.11
{-# INLINE queryDyn #-}
queryDyn :: (Monad m) => DynamicQueryT m a -> Entities -> m ([a], Entities)
queryDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> Entities -> m ([a], Entities)
queryDyn = (Map ArchetypeID Node -> Map ArchetypeID Node)
-> DynamicQueryT m a -> Entities -> m ([a], Entities)
forall (m :: * -> *) a.
Monad m =>
(Map ArchetypeID Node -> Map ArchetypeID Node)
-> DynamicQueryT m a -> Entities -> m ([a], Entities)
mapDyn' Map ArchetypeID Node -> Map ArchetypeID Node
forall a. a -> a
id

{-# INLINE mapDyn' #-}
mapDyn' ::
  (Monad m) =>
  (Map ArchetypeID Node -> Map ArchetypeID Node) ->
  DynamicQueryT m a ->
  Entities ->
  m ([a], Entities)
mapDyn' :: forall (m :: * -> *) a.
Monad m =>
(Map ArchetypeID Node -> Map ArchetypeID Node)
-> DynamicQueryT m a -> Entities -> m ([a], Entities)
mapDyn' Map ArchetypeID Node -> Map ArchetypeID Node
f DynamicQueryT m a
q Entities
es =
  let !qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
      go :: Archetype -> m ([a], Archetype)
go = DynamicQueryT m a -> Archetype -> m ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT m a
q
   in if Set ComponentID -> Bool
forall a. Set a -> Bool
Set.null (Set ComponentID -> Bool) -> Set ComponentID -> Bool
forall a b. (a -> b) -> a -> b
$ QueryFilter -> Set ComponentID
filterWith QueryFilter
qf
        then do
          ([a]
as, Archetype
_) <- Archetype -> m ([a], Archetype)
go Archetype
A.empty {A.entities = Map.keysSet $ entities es}
          ([a], Entities) -> m ([a], Entities)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
as, Entities
es)
        else
          let go' :: ([a], Entities) -> (ArchetypeID, Node) -> m ([a], Entities)
go' ([a]
acc, Entities
esAcc) (ArchetypeID
aId, Node
n) = do
                ([a]
as', Archetype
arch') <- Archetype -> m ([a], Archetype)
go (Archetype -> m ([a], Archetype))
-> Archetype -> m ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n
                let n' :: Node
n' = Node
n {nodeArchetype = arch' <> nodeArchetype n}
                    !nodes :: Map ArchetypeID Node
nodes = ArchetypeID -> Node -> Map ArchetypeID Node -> Map ArchetypeID Node
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId Node
n' (Map ArchetypeID Node -> Map ArchetypeID Node)
-> (Archetypes -> Map ArchetypeID Node)
-> Archetypes
-> Map ArchetypeID Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archetypes -> Map ArchetypeID Node
AS.nodes (Archetypes -> Map ArchetypeID Node)
-> Archetypes -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
esAcc
                ([a], Entities) -> m ([a], Entities)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
return ([a]
as' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc, Entities
esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}})
           in (([a], Entities) -> (ArchetypeID, Node) -> m ([a], Entities))
-> ([a], Entities) -> [(ArchetypeID, Node)] -> m ([a], Entities)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ([a], Entities) -> (ArchetypeID, Node) -> m ([a], Entities)
go' ([], Entities
es) ([(ArchetypeID, Node)] -> m ([a], Entities))
-> [(ArchetypeID, Node)] -> m ([a], Entities)
forall a b. (a -> b) -> a -> b
$ Map ArchetypeID Node -> [(ArchetypeID, Node)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ArchetypeID Node -> [(ArchetypeID, Node)])
-> (Archetypes -> Map ArchetypeID Node)
-> Archetypes
-> [(ArchetypeID, Node)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ArchetypeID Node -> Map ArchetypeID Node
f (Map ArchetypeID Node -> Map ArchetypeID Node)
-> (Archetypes -> Map ArchetypeID Node)
-> Archetypes
-> Map ArchetypeID Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ComponentID
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find (QueryFilter -> Set ComponentID
filterWith QueryFilter
qf) (QueryFilter -> Set ComponentID
filterWithout QueryFilter
qf) (Archetypes -> [(ArchetypeID, Node)])
-> Archetypes -> [(ArchetypeID, Node)]
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
es

-- | Map a single matched entity.
--
-- @since 0.11
mapSingleDyn :: (HasCallStack, Monad m) => DynamicQueryT m a -> Entities -> m (a, Entities)
mapSingleDyn :: forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
DynamicQueryT m a -> Entities -> m (a, Entities)
mapSingleDyn DynamicQueryT m a
q Entities
es = do
  (Maybe a
res, Entities
es') <- DynamicQueryT m a -> Entities -> m (Maybe a, Entities)
forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> Entities -> m (Maybe a, Entities)
mapSingleMaybeDyn DynamicQueryT m a
q Entities
es
  (a, Entities) -> m (a, Entities)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Entities) -> m (a, Entities))
-> (a, Entities) -> m (a, Entities)
forall a b. (a -> b) -> a -> b
$ case Maybe a
res of
    Just a
a -> (a
a, Entities
es')
    Maybe a
_ -> [Char] -> (a, Entities)
forall a. HasCallStack => [Char] -> a
error [Char]
"mapSingleDyn: expected single matching entity"

-- | Map a single matched entity, or @Nothing@.
--
-- @since 0.11
{-# INLINE mapSingleMaybeDyn #-}
mapSingleMaybeDyn :: (Monad m) => DynamicQueryT m a -> Entities -> m (Maybe a, Entities)
mapSingleMaybeDyn :: forall (m :: * -> *) a.
Monad m =>
DynamicQueryT m a -> Entities -> m (Maybe a, Entities)
mapSingleMaybeDyn DynamicQueryT m a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT m a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT m a
q
   in if Set ComponentID -> Bool
forall a. Set a -> Bool
Set.null (Set ComponentID -> Bool) -> Set ComponentID -> Bool
forall a b. (a -> b) -> a -> b
$ QueryFilter -> Set ComponentID
filterWith QueryFilter
qf
        then case Map EntityID ArchetypeID -> [EntityID]
forall k a. Map k a -> [k]
Map.keys (Map EntityID ArchetypeID -> [EntityID])
-> Map EntityID ArchetypeID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Entities -> Map EntityID ArchetypeID
entities Entities
es of
          [EntityID
eId] -> do
            ([a], Archetype)
res <- DynamicQueryT m a -> Archetype -> m ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT m a
q (Archetype -> m ([a], Archetype))
-> Archetype -> m ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ EntityID -> Archetype
A.singleton EntityID
eId
            return $ case ([a], Archetype)
res of
              ([a
a], Archetype
_) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, Entities
es)
              ([a], Archetype)
_ -> (Maybe a
forall a. Maybe a
Nothing, Entities
es)
          [EntityID]
_ -> (Maybe a, Entities) -> m (Maybe a, Entities)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
forall a. Maybe a
Nothing, Entities
es)
        else case Map ArchetypeID Node -> [(ArchetypeID, Node)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ArchetypeID Node -> [(ArchetypeID, Node)])
-> Map ArchetypeID Node -> [(ArchetypeID, Node)]
forall a b. (a -> b) -> a -> b
$ Set ComponentID
-> Set ComponentID -> Archetypes -> Map ArchetypeID Node
AS.find (QueryFilter -> Set ComponentID
filterWith QueryFilter
qf) (QueryFilter -> Set ComponentID
filterWithout QueryFilter
qf) (Archetypes -> Map ArchetypeID Node)
-> Archetypes -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
es of
          [(ArchetypeID
aId, Node
n)] -> do
            ([a]
as, Archetype
arch') <- DynamicQueryT m a -> Archetype -> m ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT m a
q (Archetype -> m ([a], Archetype))
-> Archetype -> m ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
AS.nodeArchetype Node
n
            (Maybe a, Entities) -> m (Maybe a, Entities)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a, Entities) -> m (Maybe a, Entities))
-> (Maybe a, Entities) -> m (Maybe a, Entities)
forall a b. (a -> b) -> a -> b
$ case [a]
as of
              [a
a] ->
                let nodes :: Map ArchetypeID Node
nodes = ArchetypeID -> Node -> Map ArchetypeID Node -> Map ArchetypeID Node
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ArchetypeID
aId Node
n {nodeArchetype = arch' <> nodeArchetype n} (Map ArchetypeID Node -> Map ArchetypeID Node)
-> (Archetypes -> Map ArchetypeID Node)
-> Archetypes
-> Map ArchetypeID Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archetypes -> Map ArchetypeID Node
AS.nodes (Archetypes -> Map ArchetypeID Node)
-> Archetypes -> Map ArchetypeID Node
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
es
                 in (a -> Maybe a
forall a. a -> Maybe a
Just a
a, Entities
es {archetypes = (archetypes es) {AS.nodes = nodes}})
              [a]
_ -> (Maybe a
forall a. Maybe a
Nothing, Entities
es)
          [(ArchetypeID, Node)]
_ -> (Maybe a, Entities) -> m (Maybe a, Entities)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
forall a. Maybe a
Nothing, Entities
es)

-- | `Query` filter.
--
-- @since 0.11
data QueryFilter = QueryFilter
  { QueryFilter -> Set ComponentID
filterWith :: !(Set ComponentID),
    QueryFilter -> Set ComponentID
filterWithout :: !(Set ComponentID)
  }
  deriving (Int -> QueryFilter -> ShowS
[QueryFilter] -> ShowS
QueryFilter -> [Char]
(Int -> QueryFilter -> ShowS)
-> (QueryFilter -> [Char])
-> ([QueryFilter] -> ShowS)
-> Show QueryFilter
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryFilter -> ShowS
showsPrec :: Int -> QueryFilter -> ShowS
$cshow :: QueryFilter -> [Char]
show :: QueryFilter -> [Char]
$cshowList :: [QueryFilter] -> ShowS
showList :: [QueryFilter] -> ShowS
Show)

-- | @since 0.9
instance Semigroup QueryFilter where
  QueryFilter Set ComponentID
r1 Set ComponentID
w1 <> :: QueryFilter -> QueryFilter -> QueryFilter
<> QueryFilter Set ComponentID
r2 Set ComponentID
w2 = Set ComponentID -> Set ComponentID -> QueryFilter
QueryFilter (Set ComponentID
r1 Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Set ComponentID
r2) (Set ComponentID
w1 Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Set ComponentID
w2)

-- | @since 0.9
instance Monoid QueryFilter where
  mempty :: QueryFilter
mempty = Set ComponentID -> Set ComponentID -> QueryFilter
QueryFilter Set ComponentID
forall a. Monoid a => a
mempty Set ComponentID
forall a. Monoid a => a
mempty