{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}

-- |

-- 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,

    -- ** Conversion

    liftQueryDyn,

    -- ** Running

    queryDyn,
    readQuerySingleDyn,
    readQuerySingleMaybeDyn,
    queryEntitiesDyn,
    readQueryDyn,
    querySingleDyn,
    querySingleMaybeDyn,
    readQueryEntitiesDyn,

    -- *** Internal

    QueryFilter (..),
    Operation (..),
    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 (Node (..))
import qualified Aztecs.ECS.World.Archetypes as AS
import Aztecs.ECS.World.Entities
import Control.Applicative
import Control.Monad
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Identity
import Data.Bifunctor
import Data.Foldable
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)

-- @since 0.9

type DynamicQuery = DynamicQueryT Identity

-- | Dynamic query for components by ID.

--

-- @since 0.11

data DynamicQueryT f a where
  Entity :: DynamicQueryT f EntityID
  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
  Lift :: (MonadTrans g, Monad (g f), Monad f) => DynamicQueryT f a -> DynamicQueryT (g f) a
  Op :: ComponentID -> 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 = DynamicQueryT f EntityID
forall (f :: * -> *). DynamicQueryT f EntityID
Entity

{-# INLINE fetchDyn #-}
fetchDyn :: (Component a) => ComponentID -> DynamicQueryT f a
fetchDyn :: forall a (f :: * -> *).
Component a =>
ComponentID -> DynamicQueryT f a
fetchDyn ComponentID
cId = ComponentID -> Operation f a -> DynamicQueryT f a
forall (f :: * -> *) a.
ComponentID -> Operation f a -> DynamicQueryT f a
Op ComponentID
cId Operation f a
forall a (f :: * -> *). Component a => 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 ComponentID
cId = ComponentID -> Operation f (Maybe a) -> DynamicQueryT f (Maybe a)
forall (f :: * -> *) a.
ComponentID -> Operation f a -> DynamicQueryT f a
Op ComponentID
cId Operation f (Maybe a)
forall a (f :: * -> *). Component a => 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 ComponentID
cId = ComponentID -> Operation f a -> DynamicQueryT f a
forall (f :: * -> *) a.
ComponentID -> Operation f a -> DynamicQueryT f a
Op ComponentID
cId (Operation f a -> DynamicQueryT f a)
-> Operation f a -> DynamicQueryT f a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Operation f a
forall a (f :: * -> *). Component a => (a -> a) -> 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 ComponentID
cId = ComponentID -> Operation f a -> DynamicQueryT f a
forall (f :: * -> *) a.
ComponentID -> Operation f a -> DynamicQueryT f a
Op ComponentID
cId (Operation f a -> DynamicQueryT f a)
-> Operation f a -> DynamicQueryT f a
forall a b. (a -> b) -> a -> b
$ (a -> f a) -> Operation f a
forall (f :: * -> *) a.
(Monad f, Component a) =>
(a -> f a) -> 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
<$> ComponentID -> Operation f ((), a) -> DynamicQueryT f ((), a)
forall (f :: * -> *) a.
ComponentID -> Operation f a -> DynamicQueryT f a
Op ComponentID
cId ((b -> a -> ((), a)) -> DynamicQueryT f b -> Operation f ((), a)
forall a b c (f :: * -> *).
Component a =>
(b -> a -> (c, a)) -> DynamicQueryT f b -> Operation f (c, a)
ZipFetchMap (\b
b a
a -> ((), b -> a -> a
f b
b a
a)) 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 = ComponentID -> Operation f (c, a) -> DynamicQueryT f (c, a)
forall (f :: * -> *) a.
ComponentID -> Operation f a -> DynamicQueryT f a
Op ComponentID
cId (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)) -> DynamicQueryT f b -> Operation f (c, a)
forall a b c (f :: * -> *).
Component a =>
(b -> a -> (c, a)) -> DynamicQueryT f b -> Operation f (c, a)
ZipFetchMap b -> a -> (c, a)
f 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 = ComponentID -> Operation f (c, a) -> DynamicQueryT f (c, a)
forall (f :: * -> *) a.
ComponentID -> Operation f a -> DynamicQueryT f a
Op ComponentID
cId (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)) -> DynamicQueryT f b -> Operation f (c, a)
forall (f :: * -> *) a b c.
(Monad f, Component a) =>
(b -> a -> f (c, a)) -> DynamicQueryT f b -> Operation f (c, a)
ZipFetchMapM b -> a -> f (c, a)
f DynamicQueryT f b
q

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

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

{-# INLINE liftQueryDyn #-}
liftQueryDyn :: (MonadTrans g, Monad (g f), Monad f) => DynamicQueryT f a -> DynamicQueryT (g f) a
liftQueryDyn :: forall (g :: (* -> *) -> * -> *) (f :: * -> *) a.
(MonadTrans g, Monad (g f), Monad f) =>
DynamicQueryT f a -> DynamicQueryT (g f) a
liftQueryDyn = DynamicQueryT f a -> DynamicQueryT (g f) a
forall (g :: (* -> *) -> * -> *) (f :: * -> *) a.
(MonadTrans g, Monad (g f), Monad f) =>
DynamicQueryT f a -> DynamicQueryT (g f) a
Lift

-- | Match all entities.

--

-- @since 0.11

readQueryDyn :: (Applicative f) => DynamicQueryT f a -> Entities -> f [a]
readQueryDyn :: forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Entities -> f [a]
readQueryDyn DynamicQueryT f a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT f a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f 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 f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f a
q (Archetype -> f [a]) -> Archetype -> f [a]
forall a b. (a -> b) -> a -> b
$ Archetype
A.empty {A.entities = Map.keysSet $ entities es}
        else
          let go :: Node -> f [a]
go Node
n = DynamicQueryT f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f a
q (Archetype -> f [a]) -> Archetype -> f [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]) -> f (Map ArchetypeID [a]) -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node -> f [a]) -> Map ArchetypeID Node -> f (Map ArchetypeID [a])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map ArchetypeID a -> f (Map ArchetypeID b)
traverse Node -> f [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

readQuerySingleDyn :: (HasCallStack, Applicative f) => DynamicQueryT f a -> Entities -> f a
readQuerySingleDyn :: forall (f :: * -> *) a.
(HasCallStack, Applicative f) =>
DynamicQueryT f a -> Entities -> f a
readQuerySingleDyn DynamicQueryT f a
q Entities
es = do
  Maybe a
res <- DynamicQueryT f a -> Entities -> f (Maybe a)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Entities -> f (Maybe a)
readQuerySingleMaybeDyn DynamicQueryT f 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

readQuerySingleMaybeDyn :: (Applicative f) => DynamicQueryT f a -> Entities -> f (Maybe a)
readQuerySingleMaybeDyn :: forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Entities -> f (Maybe a)
readQuerySingleMaybeDyn DynamicQueryT f a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT f a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f 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 f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f a
q (Archetype -> f [a]) -> Archetype -> f [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 -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f a
q (Archetype -> f [a]) -> Archetype -> f [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 -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

readQueryEntitiesDyn :: (Applicative f) => [EntityID] -> DynamicQueryT f a -> Entities -> f [a]
readQueryEntitiesDyn :: forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Entities -> f [a]
readQueryEntitiesDyn [EntityID]
eIds DynamicQueryT f a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT f a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f 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 f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
[EntityID] -> DynamicQueryT f a -> Archetype -> f [a]
readDynQueryEntities [EntityID]
eIds DynamicQueryT f a
q Archetype
A.empty {A.entities = Map.keysSet $ entities es}
        else
          let go :: Node -> f [a]
go Node
n = DynamicQueryT f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f [a]
readDynQuery DynamicQueryT f a
q (Archetype -> f [a]) -> Archetype -> f [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]) -> f (Map ArchetypeID [a]) -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node -> f [a]) -> Map ArchetypeID Node -> f (Map ArchetypeID [a])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map ArchetypeID a -> f (Map ArchetypeID b)
traverse Node -> f [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 and update all matched entities.

--

-- @since 0.11

{-# INLINE queryDyn #-}
queryDyn :: (Applicative f) => DynamicQueryT f a -> Entities -> f ([a], Entities)
queryDyn :: forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Entities -> f ([a], Entities)
queryDyn DynamicQueryT f a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT f a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f 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 (,Entities
es) ([a] -> ([a], Entities))
-> (([a], Archetype) -> [a]) -> ([a], Archetype) -> ([a], Entities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], Archetype) -> [a]
forall a b. (a, b) -> a
fst (([a], Archetype) -> ([a], Entities))
-> f ([a], Archetype) -> f ([a], Entities)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
A.empty {A.entities = Map.keysSet $ entities es}
        else
          let go :: (ArchetypeID, Node) -> f ([a], ArchetypeID, Node)
go (ArchetypeID
aId, Node
n) = 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 -> f ([a], Archetype))
-> Archetype -> f ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n
                return $
                  let ([a]
as', Archetype
arch') = ([a], Archetype)
res
                   in ([a]
as', ArchetypeID
aId, Node
n {nodeArchetype = arch' <> nodeArchetype n})
              matches :: [(ArchetypeID, Node)]
matches = 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
              res' :: f [([a], ArchetypeID, Node)]
res' = ((ArchetypeID, Node) -> f ([a], ArchetypeID, Node))
-> [(ArchetypeID, Node)] -> f [([a], ArchetypeID, Node)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (ArchetypeID, Node) -> f ([a], ArchetypeID, Node)
go [(ArchetypeID, Node)]
matches
              folder :: ([a], Entities) -> ([a], ArchetypeID, Node) -> ([a], Entities)
folder ([a]
acc, Entities
esAcc) ([a]
as, ArchetypeID
aId, Node
node) =
                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
node (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
                 in ([a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc, Entities
esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}})
           in ([([a], ArchetypeID, Node)] -> ([a], Entities))
-> f [([a], ArchetypeID, Node)] -> f ([a], Entities)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([a], Entities) -> ([a], ArchetypeID, Node) -> ([a], Entities))
-> ([a], Entities) -> [([a], ArchetypeID, Node)] -> ([a], Entities)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([a], Entities) -> ([a], ArchetypeID, Node) -> ([a], Entities)
forall {a}.
([a], Entities) -> ([a], ArchetypeID, Node) -> ([a], Entities)
folder ([], Entities
es)) f [([a], ArchetypeID, Node)]
res'

-- | Match and update a single entity.

--

-- @since 0.11

querySingleDyn :: (HasCallStack, Applicative m) => DynamicQueryT m a -> Entities -> m (a, Entities)
querySingleDyn :: forall (m :: * -> *) a.
(HasCallStack, Applicative m) =>
DynamicQueryT m a -> Entities -> m (a, Entities)
querySingleDyn DynamicQueryT m a
q Entities
es = do
  (Maybe a, Entities)
res <- DynamicQueryT m a -> Entities -> m (Maybe a, Entities)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Entities -> f (Maybe a, Entities)
querySingleMaybeDyn DynamicQueryT m a
q Entities
es
  return $ case (Maybe a, Entities)
res of
    (Just a
a, Entities
es') -> (a
a, Entities
es')
    (Maybe a, Entities)
_ -> [Char] -> (a, Entities)
forall a. HasCallStack => [Char] -> a
error [Char]
"mapSingleDyn: expected single matching entity"

-- | Match and update a single entity, or @Nothing@.

--

-- @since 0.11

{-# INLINE querySingleMaybeDyn #-}
querySingleMaybeDyn :: (Applicative f) => DynamicQueryT f a -> Entities -> f (Maybe a, Entities)
querySingleMaybeDyn :: forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Entities -> f (Maybe a, Entities)
querySingleMaybeDyn DynamicQueryT f a
q Entities
es =
  let qf :: QueryFilter
qf = DynamicQueryT f a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f 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 f a -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
DynamicQueryT f a -> Archetype -> f ([a], Archetype)
runDynQuery DynamicQueryT f a
q (Archetype -> f ([a], Archetype))
-> Archetype -> f ([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) -> f (Maybe a, Entities)
forall a. a -> f 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], 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 -> f ([a], Archetype))
-> Archetype -> f ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
AS.nodeArchetype Node
n
            return $ case ([a], Archetype)
res of
              ([a
a], Archetype
arch') ->
                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], Archetype)
_ -> (Maybe a
forall a. Maybe a
Nothing, Entities
es)
          [(ArchetypeID, Node)]
_ -> (Maybe a, Entities) -> f (Maybe a, Entities)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
forall a. Maybe a
Nothing, Entities
es)

{-# 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

{-# 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 (Lift DynamicQueryT f a
q) = DynamicQueryT f a -> QueryFilter
forall (f :: * -> *) a. DynamicQueryT f a -> QueryFilter
queryFilter DynamicQueryT f a
q
queryFilter DynamicQueryT f a
Entity = QueryFilter
forall a. Monoid a => a
mempty
queryFilter (Op ComponentID
cId Operation f a
op) = ComponentID -> Operation f a -> QueryFilter
forall (f :: * -> *) a. ComponentID -> Operation f a -> QueryFilter
opFilter ComponentID
cId Operation f a
op

{-# 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 (Lift DynamicQueryT f a
q) Archetype
arch = f [a] -> g f [a]
forall (m :: * -> *) a. Monad m => m a -> g m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f [a] -> g f [a]) -> f [a] -> g f [a]
forall a b. (a -> b) -> a -> 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 DynamicQueryT 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
readDynQuery (Op ComponentID
cId Operation f a
op) Archetype
arch = ComponentID -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f [a]
readOp ComponentID
cId Operation f a
op Archetype
arch

{-# 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 (Lift DynamicQueryT f a
q) Archetype
arch = f [a] -> g f [a]
forall (m :: * -> *) a. Monad m => m a -> g m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f [a] -> g f [a]) -> f [a] -> g f [a]
forall a b. (a -> b) -> a -> 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 DynamicQueryT f a
Entity Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
[EntityID]
es
readDynQueryEntities [EntityID]
es (Op ComponentID
cId Operation f a
op) Archetype
arch = ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
readOpEntities ComponentID
cId [EntityID]
es Operation f a
op 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 (Lift DynamicQueryT f a
q) Archetype
arch = f ([a], Archetype) -> g f ([a], Archetype)
forall (m :: * -> *) a. Monad m => m a -> g m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f ([a], Archetype) -> g f ([a], Archetype))
-> f ([a], Archetype) -> g f ([a], Archetype)
forall a b. (a -> b) -> a -> b
$ 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
runDynQuery DynamicQueryT f a
Entity Archetype
arch = (,Archetype
arch) ([a] -> ([a], Archetype)) -> f [a] -> f ([a], Archetype)
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
DynamicQueryT f EntityID
forall (f :: * -> *). DynamicQueryT f EntityID
Entity Archetype
arch
runDynQuery (Op ComponentID
cId Operation f a
op) Archetype
arch = ComponentID -> Operation f a -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f ([a], Archetype)
runOp ComponentID
cId Operation f a
op 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 (Lift DynamicQueryT f a
q) Archetype
arch = f ([a], Archetype) -> g f ([a], Archetype)
forall (m :: * -> *) a. Monad m => m a -> g m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f ([a], Archetype) -> g f ([a], Archetype))
-> f ([a], Archetype) -> g f ([a], Archetype)
forall a b. (a -> b) -> a -> 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 DynamicQueryT f a
Entity 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)
runDynQueryEntities [EntityID]
es (Op ComponentID
cId Operation f a
op) Archetype
arch = ComponentID
-> [EntityID] -> Operation f a -> Archetype -> f ([a], Archetype)
forall (f :: * -> *) a.
Applicative f =>
ComponentID
-> [EntityID] -> Operation f a -> Archetype -> f ([a], Archetype)
runOpEntities ComponentID
cId [EntityID]
es Operation f a
op Archetype
arch

data Operation f a where
  Fetch :: (Component a) => Operation f a
  FetchMaybe :: (Component a) => Operation f (Maybe a)
  FetchMap :: (Component a) => (a -> a) -> Operation f a
  FetchMapM :: (Monad f, Component a) => (a -> f a) -> Operation f a
  ZipFetchMap :: (Component a) => (b -> a -> (c, a)) -> (DynamicQueryT f b) -> Operation f (c, a)
  ZipFetchMapM :: (Monad f, Component a) => (b -> a -> f (c, a)) -> (DynamicQueryT f b) -> Operation f (c, a)
  With :: Operation f ()
  Without :: Operation f ()

{-# INLINE opFilter #-}
opFilter :: ComponentID -> Operation f a -> QueryFilter
opFilter :: forall (f :: * -> *) a. ComponentID -> Operation f a -> QueryFilter
opFilter ComponentID
cId Operation f a
Fetch = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter ComponentID
cId Operation f a
FetchMaybe = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter ComponentID
cId (FetchMap a -> a
_) = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter ComponentID
cId (FetchMapM a -> f a
_) = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter ComponentID
cId (ZipFetchMap b -> a -> (c, a)
_ 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 ComponentID
cId (ZipFetchMapM b -> a -> f (c, a)
_ 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 ComponentID
cId Operation f a
With = QueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}
opFilter ComponentID
cId Operation f a
Without = QueryFilter
forall a. Monoid a => a
mempty {filterWithout = Set.singleton cId}

{-# INLINE readOp #-}
readOp :: (Applicative f) => ComponentID -> Operation f a -> Archetype -> f [a]
readOp :: forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f [a]
readOp ComponentID
cId Operation f a
Fetch 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 ComponentID
cId Operation f a
FetchMaybe 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 ComponentID
cId (FetchMap a -> a
f) Archetype
arch = do
  [a]
bs <- ComponentID -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f [a]
readOp ComponentID
cId Operation f a
forall a (f :: * -> *). Component a => Operation f a
Fetch Archetype
arch
  return $ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
bs
readOp ComponentID
cId (FetchMapM a -> f a
f) Archetype
arch = do
  [a]
bs <- ComponentID -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f [a]
readOp ComponentID
cId Operation f a
forall a (f :: * -> *). Component a => Operation f a
Fetch 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 ComponentID
cId (ZipFetchMap b -> a -> (c, a)
f 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 <- ComponentID -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f [a]
readOp ComponentID
cId Operation f a
forall a (f :: * -> *). Component a => Operation f a
Fetch 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 ComponentID
cId (ZipFetchMapM b -> a -> f (c, a)
f 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 <- ComponentID -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f [a]
readOp ComponentID
cId Operation f a
forall a (f :: * -> *). Component a => Operation f a
Fetch 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 ComponentID
_ Operation f a
With Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
readOp ComponentID
_ Operation f a
Without Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

{-# INLINE runOp #-}
runOp :: (Applicative f) => ComponentID -> Operation f a -> Archetype -> f ([a], Archetype)
runOp :: forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f ([a], Archetype)
runOp ComponentID
cId (FetchMap a -> a
f) 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 ComponentID
cId (FetchMapM a -> f a
f) 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 ComponentID
cId (ZipFetchMap b -> a -> (c, a)
f 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.zipMap [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 ComponentID
cId (ZipFetchMapM b -> a -> f (c, a)
f 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.zipMapM [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 ComponentID
cId Operation f a
op Archetype
arch = (,Archetype
forall a. Monoid a => a
mempty) ([a] -> ([a], Archetype)) -> f [a] -> f ([a], Archetype)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComponentID -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> Operation f a -> Archetype -> f [a]
readOp ComponentID
cId Operation f a
op Archetype
arch

{-# INLINE readOpEntities #-}
readOpEntities :: (Applicative f) => ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
readOpEntities :: forall (f :: * -> *) a.
Applicative f =>
ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
readOpEntities ComponentID
cId [EntityID]
es Operation f a
Fetch 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 ComponentID
cId [EntityID]
es Operation f a
FetchMaybe 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 ComponentID
cId [EntityID]
es (FetchMap a -> a
f) Archetype
arch = do
  [a]
b <- ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
readOpEntities ComponentID
cId [EntityID]
es Operation f a
forall a (f :: * -> *). Component a => Operation f a
Fetch Archetype
arch
  pure $ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
b
readOpEntities ComponentID
cId [EntityID]
es (FetchMapM a -> f a
f) Archetype
arch = do
  [a]
b <- ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
readOpEntities ComponentID
cId [EntityID]
es Operation f a
forall a (f :: * -> *). Component a => Operation f a
Fetch 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 ComponentID
cId [EntityID]
es (ZipFetchMap b -> a -> (c, a)
f DynamicQueryT f b
q) 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 <- ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
readOpEntities ComponentID
cId [EntityID]
es Operation f a
forall a (f :: * -> *). Component a => Operation f a
Fetch 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 ComponentID
cId [EntityID]
es (ZipFetchMapM b -> a -> f (c, a)
f DynamicQueryT f b
q) 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 <- ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
readOpEntities ComponentID
cId [EntityID]
es Operation f a
forall a (f :: * -> *). Component a => Operation f a
Fetch 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 ComponentID
_ [EntityID]
_ Operation f a
With Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
readOpEntities ComponentID
_ [EntityID]
_ Operation f a
Without Archetype
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

runOpEntities :: (Applicative f) => ComponentID -> [EntityID] -> Operation f a -> Archetype -> f ([a], Archetype)
runOpEntities :: forall (f :: * -> *) a.
Applicative f =>
ComponentID
-> [EntityID] -> Operation f a -> Archetype -> f ([a], Archetype)
runOpEntities ComponentID
cId [EntityID]
es (FetchMap a -> a
f) 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.zipMap [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 ComponentID
cId [EntityID]
es (FetchMapM a -> f a
f) Archetype
arch = do
  ([(a, a)]
as, Archetype
arch') <- ComponentID
-> [EntityID]
-> Operation f (a, a)
-> Archetype
-> f ([(a, a)], Archetype)
forall (f :: * -> *) a.
Applicative f =>
ComponentID
-> [EntityID] -> Operation f a -> Archetype -> f ([a], Archetype)
runOpEntities ComponentID
cId [EntityID]
es ((() -> a -> f (a, a)) -> DynamicQueryT f () -> Operation f (a, a)
forall (f :: * -> *) a b c.
(Monad f, Component a) =>
(b -> a -> f (c, a)) -> DynamicQueryT f b -> Operation f (c, a)
ZipFetchMapM (\() 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) (() -> DynamicQueryT f ()
forall a. a -> DynamicQueryT f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) 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 ComponentID
cId [EntityID]
es (ZipFetchMap b -> a -> (c, a)
f 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 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.zipMap ([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 ComponentID
cId [EntityID]
es (ZipFetchMapM b -> a -> f (c, a)
f DynamicQueryT f b
q) 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.zipMapM ([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 ComponentID
cId [EntityID]
es Operation f a
op Archetype
arch = (,Archetype
arch) ([a] -> ([a], Archetype)) -> f [a] -> f ([a], Archetype)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
forall (f :: * -> *) a.
Applicative f =>
ComponentID -> [EntityID] -> Operation f a -> Archetype -> f [a]
readOpEntities ComponentID
cId [EntityID]
es Operation f a
op Archetype
arch

-- | `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