{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Aztecs.ECS.Query
-- 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)
--
-- Query for matching entities.
--
-- === Do notation:
-- > move :: (ArrowQuery arr) => arr () Position
-- > move = proc () -> do
-- >   Velocity v <- Q.fetch -< ()
-- >   Position p <- Q.fetch -< ()
-- >   Q.set -< Position $ p + v
--
-- === Arrow combinators:
-- > move :: (ArrowQuery arr) => arr () Position
-- > move = Q.fetch &&& Q.fetch >>> arr (\(Position p, Velocity v) -> Position $ p + v) >>> Q.set
--
-- === Applicative combinators:
-- > move :: (ArrowQuery arr) => arr () Position
-- > move = (,) <$> Q.fetch <*> Q.fetch >>> arr (\(Position p, Velocity v) -> Position $ p + v) >>> Q.set
module Aztecs.ECS.Query
  ( -- * Queries
    Query,
    QueryT (..),
    QueryReaderF (..),
    QueryF (..),
    DynamicQueryReaderF (..),
    DynamicQueryF (..),

    -- ** Running
    all,
    all',
    single,
    single',
    singleMaybe,
    singleMaybe',
    map,
    mapSingle,
    mapSingleMaybe,

    -- ** Conversion
    fromReader,
    toReader,
    fromDyn,

    -- * Filters
    QueryFilter (..),
    with,
    without,

    -- * Reads and writes
    ReadsWrites (..),
    disjoint,
  )
where

import Aztecs.ECS.Component
import Aztecs.ECS.Query.Class
import Aztecs.ECS.Query.Dynamic
import Aztecs.ECS.Query.Reader (QueryFilter (..), QueryReader (..), with, without)
import qualified Aztecs.ECS.Query.Reader as QR
import Aztecs.ECS.Query.Reader.Class
import Aztecs.ECS.World.Components (Components)
import qualified Aztecs.ECS.World.Components as CS
import Aztecs.ECS.World.Entities (Entities (..))
import Control.Category
import Control.Monad.Identity
import Control.Monad.Writer
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Stack
import Prelude hiding (all, id, map, reads, (.))

-- | @since 0.10
type Query = QueryT Identity

-- | Query for matching entities.
--
-- @since 0.10
newtype QueryT f a = Query
  { -- | Run a query, producing a `DynamicQueryT`.
    --
    -- @since 0.10
    forall (f :: * -> *) a.
QueryT f a
-> Components -> (ReadsWrites, Components, DynamicQueryT f a)
runQuery :: Components -> (ReadsWrites, Components, DynamicQueryT f a)
  }
  deriving ((forall a b. (a -> b) -> QueryT f a -> QueryT f b)
-> (forall a b. a -> QueryT f b -> QueryT f a)
-> Functor (QueryT f)
forall a b. a -> QueryT f b -> QueryT f a
forall a b. (a -> b) -> QueryT f a -> QueryT f b
forall (f :: * -> *) a b.
Functor f =>
a -> QueryT f b -> QueryT f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> QueryT f a -> QueryT f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> QueryT f a -> QueryT f b
fmap :: forall a b. (a -> b) -> QueryT f a -> QueryT f b
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> QueryT f b -> QueryT f a
<$ :: forall a b. a -> QueryT f b -> QueryT f a
Functor)

-- | @since 0.10
instance (Applicative f) => Applicative (QueryT f) where
  {-# INLINE pure #-}
  pure :: forall a. a -> QueryT f a
pure a
a = (Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
forall (f :: * -> *) a.
(Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
Query (ReadsWrites
forall a. Monoid a => a
mempty,,a -> DynamicQueryT f a
forall a. a -> DynamicQueryT f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)

  {-# INLINE (<*>) #-}
  (Query Components -> (ReadsWrites, Components, DynamicQueryT f (a -> b))
f) <*> :: forall a b. QueryT f (a -> b) -> QueryT f a -> QueryT f b
<*> (Query Components -> (ReadsWrites, Components, DynamicQueryT f a)
g) = (Components -> (ReadsWrites, Components, DynamicQueryT f b))
-> QueryT f b
forall (f :: * -> *) a.
(Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
Query ((Components -> (ReadsWrites, Components, DynamicQueryT f b))
 -> QueryT f b)
-> (Components -> (ReadsWrites, Components, DynamicQueryT f b))
-> QueryT f b
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let !(ReadsWrites
cIdsG, Components
cs', DynamicQueryT f a
aQS) = Components -> (ReadsWrites, Components, DynamicQueryT f a)
g Components
cs
        !(ReadsWrites
cIdsF, Components
cs'', DynamicQueryT f (a -> b)
bQS) = Components -> (ReadsWrites, Components, DynamicQueryT f (a -> b))
f Components
cs'
     in (ReadsWrites
cIdsG ReadsWrites -> ReadsWrites -> ReadsWrites
forall a. Semigroup a => a -> a -> a
<> ReadsWrites
cIdsF, Components
cs'', DynamicQueryT f (a -> b)
bQS DynamicQueryT f (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
forall a b.
DynamicQueryT f (a -> b) -> DynamicQueryT f a -> DynamicQueryT f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DynamicQueryT f a
aQS)

-- | @since 0.10
instance (Applicative f) => QueryReaderF (QueryT f) where
  {-# INLINE fetch #-}
  fetch :: forall a. Component a => QueryT f a
fetch = QueryReader a -> QueryT f a
forall (f :: * -> *) a.
Applicative f =>
QueryReader a -> QueryT f a
fromReader QueryReader a
forall a. Component a => QueryReader a
forall (f :: * -> *) a. (QueryReaderF f, Component a) => f a
fetch

  {-# INLINE fetchMaybe #-}
  fetchMaybe :: forall a. Component a => QueryT f (Maybe a)
fetchMaybe = QueryReader (Maybe a) -> QueryT f (Maybe a)
forall (f :: * -> *) a.
Applicative f =>
QueryReader a -> QueryT f a
fromReader QueryReader (Maybe a)
forall a. Component a => QueryReader (Maybe a)
forall (f :: * -> *) a.
(QueryReaderF f, Component a) =>
f (Maybe a)
fetchMaybe

-- | @since 0.10
instance (Applicative f) => DynamicQueryReaderF (QueryT f) where
  {-# INLINE entity #-}
  entity :: QueryT f EntityID
entity = QueryReader EntityID -> QueryT f EntityID
forall (f :: * -> *) a.
Applicative f =>
QueryReader a -> QueryT f a
fromReader QueryReader EntityID
forall (f :: * -> *). DynamicQueryReaderF f => f EntityID
entity

  {-# INLINE fetchDyn #-}
  fetchDyn :: forall a. Component a => ComponentID -> QueryT f a
fetchDyn = QueryReader a -> QueryT f a
forall (f :: * -> *) a.
Applicative f =>
QueryReader a -> QueryT f a
fromReader (QueryReader a -> QueryT f a)
-> (ComponentID -> QueryReader a) -> ComponentID -> QueryT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ComponentID -> QueryReader a
forall a. Component a => ComponentID -> QueryReader a
forall (f :: * -> *) a.
(DynamicQueryReaderF f, Component a) =>
ComponentID -> f a
fetchDyn

  {-# INLINE fetchMaybeDyn #-}
  fetchMaybeDyn :: forall a. Component a => ComponentID -> QueryT f (Maybe a)
fetchMaybeDyn = QueryReader (Maybe a) -> QueryT f (Maybe a)
forall (f :: * -> *) a.
Applicative f =>
QueryReader a -> QueryT f a
fromReader (QueryReader (Maybe a) -> QueryT f (Maybe a))
-> (ComponentID -> QueryReader (Maybe a))
-> ComponentID
-> QueryT f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ComponentID -> QueryReader (Maybe a)
forall a. Component a => ComponentID -> QueryReader (Maybe a)
forall (f :: * -> *) a.
(DynamicQueryReaderF f, Component a) =>
ComponentID -> f (Maybe a)
fetchMaybeDyn

-- | @since 0.10
instance (Applicative f) => DynamicQueryF f (QueryT f) where
  {-# INLINE adjustDyn #-}
  adjustDyn :: forall a b.
Component a =>
(b -> a -> a) -> ComponentID -> QueryT f b -> QueryT f a
adjustDyn b -> a -> a
f = (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID -> QueryT f b -> QueryT f a
forall (f :: * -> *) b a.
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID -> QueryT f b -> QueryT f a
fromDynInternal ((ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
 -> ComponentID -> QueryT f b -> QueryT f a)
-> (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID
-> QueryT f b
-> QueryT f a
forall a b. (a -> b) -> a -> b
$ (b -> a -> a)
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
forall a b.
Component a =>
(b -> a -> a)
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
forall (m :: * -> *) (f :: * -> *) a b.
(DynamicQueryF m f, Component a) =>
(b -> a -> a) -> ComponentID -> f b -> f a
adjustDyn b -> a -> a
f

  {-# INLINE adjustDyn_ #-}
  adjustDyn_ :: forall a b.
Component a =>
(b -> a -> a) -> ComponentID -> QueryT f b -> QueryT f ()
adjustDyn_ b -> a -> a
f = (ComponentID -> DynamicQueryT f b -> DynamicQueryT f ())
-> ComponentID -> QueryT f b -> QueryT f ()
forall (f :: * -> *) b a.
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID -> QueryT f b -> QueryT f a
fromDynInternal ((ComponentID -> DynamicQueryT f b -> DynamicQueryT f ())
 -> ComponentID -> QueryT f b -> QueryT f ())
-> (ComponentID -> DynamicQueryT f b -> DynamicQueryT f ())
-> ComponentID
-> QueryT f b
-> QueryT f ()
forall a b. (a -> b) -> a -> b
$ (b -> a -> a)
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f ()
forall a b.
Component a =>
(b -> a -> a)
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f ()
forall (m :: * -> *) (f :: * -> *) a b.
(DynamicQueryF m f, Component a) =>
(b -> a -> a) -> ComponentID -> f b -> f ()
adjustDyn_ b -> a -> a
f

  {-# INLINE adjustDynM #-}
  adjustDynM :: forall a b.
(Monad f, Component a) =>
(b -> a -> f a) -> ComponentID -> QueryT f b -> QueryT f a
adjustDynM b -> a -> f a
f = (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID -> QueryT f b -> QueryT f a
forall (f :: * -> *) b a.
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID -> QueryT f b -> QueryT f a
fromDynInternal ((ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
 -> ComponentID -> QueryT f b -> QueryT f a)
-> (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID
-> QueryT f b
-> QueryT f a
forall a b. (a -> b) -> a -> b
$ (b -> a -> f a)
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
forall a b.
(Monad f, Component a) =>
(b -> a -> f a)
-> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
forall (m :: * -> *) (f :: * -> *) a b.
(DynamicQueryF m f, Monad m, Component a) =>
(b -> a -> m a) -> ComponentID -> f b -> f a
adjustDynM b -> a -> f a
f

  {-# INLINE setDyn #-}
  setDyn :: forall a. Component a => ComponentID -> QueryT f a -> QueryT f a
setDyn = (ComponentID -> DynamicQueryT f a -> DynamicQueryT f a)
-> ComponentID -> QueryT f a -> QueryT f a
forall (f :: * -> *) b a.
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID -> QueryT f b -> QueryT f a
fromDynInternal ComponentID -> DynamicQueryT f a -> DynamicQueryT f a
forall a.
Component a =>
ComponentID -> DynamicQueryT f a -> DynamicQueryT f a
forall (m :: * -> *) (f :: * -> *) a.
(DynamicQueryF m f, Component a) =>
ComponentID -> f a -> f a
setDyn

-- | @since 0.9
instance (Monad m) => QueryF m (QueryT m) where
  {-# INLINE adjust #-}
  adjust :: forall a b. (Component a) => (b -> a -> a) -> QueryT m b -> QueryT m a
  adjust :: forall a b.
Component a =>
(b -> a -> a) -> QueryT m b -> QueryT m a
adjust b -> a -> a
f = forall c (f :: * -> *) a b.
(Applicative f, Component c) =>
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> QueryT f b -> QueryT f a
fromWriterInternal @a ((ComponentID -> DynamicQueryT m b -> DynamicQueryT m a)
 -> QueryT m b -> QueryT m a)
-> (ComponentID -> DynamicQueryT m b -> DynamicQueryT m a)
-> QueryT m b
-> QueryT m a
forall a b. (a -> b) -> a -> b
$ (b -> a -> a)
-> ComponentID -> DynamicQueryT m b -> DynamicQueryT m a
forall a b.
Component a =>
(b -> a -> a)
-> ComponentID -> DynamicQueryT m b -> DynamicQueryT m a
forall (m :: * -> *) (f :: * -> *) a b.
(DynamicQueryF m f, Component a) =>
(b -> a -> a) -> ComponentID -> f b -> f a
adjustDyn b -> a -> a
f

  {-# INLINE adjust_ #-}
  adjust_ :: forall a b. (Component a) => (b -> a -> a) -> QueryT m b -> QueryT m ()
  adjust_ :: forall a b.
Component a =>
(b -> a -> a) -> QueryT m b -> QueryT m ()
adjust_ b -> a -> a
f = forall c (f :: * -> *) a b.
(Applicative f, Component c) =>
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> QueryT f b -> QueryT f a
fromWriterInternal @a ((ComponentID -> DynamicQueryT m b -> DynamicQueryT m ())
 -> QueryT m b -> QueryT m ())
-> (ComponentID -> DynamicQueryT m b -> DynamicQueryT m ())
-> QueryT m b
-> QueryT m ()
forall a b. (a -> b) -> a -> b
$ (b -> a -> a)
-> ComponentID -> DynamicQueryT m b -> DynamicQueryT m ()
forall a b.
Component a =>
(b -> a -> a)
-> ComponentID -> DynamicQueryT m b -> DynamicQueryT m ()
forall (m :: * -> *) (f :: * -> *) a b.
(DynamicQueryF m f, Component a) =>
(b -> a -> a) -> ComponentID -> f b -> f ()
adjustDyn_ b -> a -> a
f

  {-# INLINE adjustM #-}
  adjustM :: forall a b. (Component a, Monad m) => (b -> a -> m a) -> QueryT m b -> QueryT m a
  adjustM :: forall a b.
(Component a, Monad m) =>
(b -> a -> m a) -> QueryT m b -> QueryT m a
adjustM b -> a -> m a
f = forall c (f :: * -> *) a b.
(Applicative f, Component c) =>
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> QueryT f b -> QueryT f a
fromWriterInternal @a ((ComponentID -> DynamicQueryT m b -> DynamicQueryT m a)
 -> QueryT m b -> QueryT m a)
-> (ComponentID -> DynamicQueryT m b -> DynamicQueryT m a)
-> QueryT m b
-> QueryT m a
forall a b. (a -> b) -> a -> b
$ (b -> a -> m a)
-> ComponentID -> DynamicQueryT m b -> DynamicQueryT m a
forall a b.
(Monad m, Component a) =>
(b -> a -> m a)
-> ComponentID -> DynamicQueryT m b -> DynamicQueryT m a
forall (m :: * -> *) (f :: * -> *) a b.
(DynamicQueryF m f, Monad m, Component a) =>
(b -> a -> m a) -> ComponentID -> f b -> f a
adjustDynM b -> a -> m a
f

  {-# INLINE set #-}
  set :: forall a. (Component a) => QueryT m a -> QueryT m a
  set :: forall a. Component a => QueryT m a -> QueryT m a
set = forall c (f :: * -> *) a b.
(Applicative f, Component c) =>
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> QueryT f b -> QueryT f a
fromWriterInternal @a ComponentID -> DynamicQueryT m a -> DynamicQueryT m a
forall a.
Component a =>
ComponentID -> DynamicQueryT m a -> DynamicQueryT m a
forall (m :: * -> *) (f :: * -> *) a.
(DynamicQueryF m f, Component a) =>
ComponentID -> f a -> f a
setDyn

-- | Convert a `QueryReader` to a `Query`.
--
-- @since 0.9
{-# INLINE fromReader #-}
fromReader :: (Applicative f) => QueryReader a -> QueryT f a
fromReader :: forall (f :: * -> *) a.
Applicative f =>
QueryReader a -> QueryT f a
fromReader (QueryReader Components -> (Set ComponentID, Components, DynamicQueryReader a)
f) = (Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
forall (f :: * -> *) a.
(Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
Query ((Components -> (ReadsWrites, Components, DynamicQueryT f a))
 -> QueryT f a)
-> (Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let !(Set ComponentID
cIds, Components
cs', DynamicQueryReader a
dynQ) = Components -> (Set ComponentID, Components, DynamicQueryReader a)
f Components
cs in (Set ComponentID -> Set ComponentID -> ReadsWrites
ReadsWrites Set ComponentID
cIds Set ComponentID
forall a. Set a
Set.empty, Components
cs', DynamicQueryReader a -> DynamicQueryT f a
forall (m :: * -> *) a.
Applicative m =>
DynamicQueryReader a -> DynamicQueryT m a
fromDynReader DynamicQueryReader a
dynQ)

-- | Convert a `Query` to a `QueryReader`.
--
-- @since 0.10
{-# INLINE toReader #-}
toReader :: Query a -> QueryReader a
toReader :: forall a. Query a -> QueryReader a
toReader (Query Components -> (ReadsWrites, Components, DynamicQueryT Identity a)
f) = (Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
forall a.
(Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
QueryReader ((Components
  -> (Set ComponentID, Components, DynamicQueryReader a))
 -> QueryReader a)
-> (Components
    -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let !(ReadsWrites
rws, Components
cs', DynamicQueryT Identity a
dynQ) = Components -> (ReadsWrites, Components, DynamicQueryT Identity a)
f Components
cs in (ReadsWrites -> Set ComponentID
reads ReadsWrites
rws, Components
cs', DynamicQueryT Identity a -> DynamicQueryReader a
forall a. DynamicQuery a -> DynamicQueryReader a
toDynReader DynamicQueryT Identity a
dynQ)

-- | Convert a `DynamicQueryT` to a `QueryT`.
--
-- @since 0.10
{-# INLINE fromDyn #-}
fromDyn :: ReadsWrites -> DynamicQueryT f a -> QueryT f a
fromDyn :: forall (f :: * -> *) a.
ReadsWrites -> DynamicQueryT f a -> QueryT f a
fromDyn ReadsWrites
rws DynamicQueryT f a
q = (Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
forall (f :: * -> *) a.
(Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
Query (ReadsWrites
rws,,DynamicQueryT f a
q)

{-# INLINE fromDynInternal #-}
fromDynInternal ::
  (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a) ->
  ComponentID ->
  QueryT f b ->
  QueryT f a
fromDynInternal :: forall (f :: * -> *) b a.
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> ComponentID -> QueryT f b -> QueryT f a
fromDynInternal ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
f ComponentID
cId QueryT f b
q = (Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
forall (f :: * -> *) a.
(Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
Query ((Components -> (ReadsWrites, Components, DynamicQueryT f a))
 -> QueryT f a)
-> (Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let !(ReadsWrites
rws, Components
cs', DynamicQueryT f b
dynQ) = QueryT f b
-> Components -> (ReadsWrites, Components, DynamicQueryT f b)
forall (f :: * -> *) a.
QueryT f a
-> Components -> (ReadsWrites, Components, DynamicQueryT f a)
runQuery QueryT f b
q Components
cs
   in (ReadsWrites
rws ReadsWrites -> ReadsWrites -> ReadsWrites
forall a. Semigroup a => a -> a -> a
<> Set ComponentID -> Set ComponentID -> ReadsWrites
ReadsWrites Set ComponentID
forall a. Set a
Set.empty (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId), Components
cs', ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
f ComponentID
cId DynamicQueryT f b
dynQ)

{-# INLINE fromWriterInternal #-}
fromWriterInternal ::
  forall c f a b.
  (Applicative f, Component c) =>
  (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a) ->
  QueryT f b ->
  QueryT f a
fromWriterInternal :: forall c (f :: * -> *) a b.
(Applicative f, Component c) =>
(ComponentID -> DynamicQueryT f b -> DynamicQueryT f a)
-> QueryT f b -> QueryT f a
fromWriterInternal ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
f QueryT f b
q = (Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
forall (f :: * -> *) a.
(Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
Query ((Components -> (ReadsWrites, Components, DynamicQueryT f a))
 -> QueryT f a)
-> (Components -> (ReadsWrites, Components, DynamicQueryT f a))
-> QueryT f a
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let !(ComponentID
cId, Components
cs') = forall a. Component a => Components -> (ComponentID, Components)
CS.insert @c Components
cs
      !(ReadsWrites
rws, Components
cs'', DynamicQueryT f b
dynQ) = QueryT f b
-> Components -> (ReadsWrites, Components, DynamicQueryT f b)
forall (f :: * -> *) a.
QueryT f a
-> Components -> (ReadsWrites, Components, DynamicQueryT f a)
runQuery QueryT f b
q Components
cs'
   in (ReadsWrites
rws ReadsWrites -> ReadsWrites -> ReadsWrites
forall a. Semigroup a => a -> a -> a
<> Set ComponentID -> Set ComponentID -> ReadsWrites
ReadsWrites Set ComponentID
forall a. Set a
Set.empty (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId), Components
cs'', ComponentID -> DynamicQueryT f b -> DynamicQueryT f a
f ComponentID
cId DynamicQueryT f b
dynQ)

-- | Reads and writes of a `Query`.
--
-- @since 0.9
data ReadsWrites = ReadsWrites
  { -- | Component IDs being read.
    --
    -- @since 0.9
    ReadsWrites -> Set ComponentID
reads :: !(Set ComponentID),
    -- | Component IDs being written.
    --
    -- @since 0.9
    ReadsWrites -> Set ComponentID
writes :: !(Set ComponentID)
  }
  deriving (Int -> ReadsWrites -> ShowS
[ReadsWrites] -> ShowS
ReadsWrites -> String
(Int -> ReadsWrites -> ShowS)
-> (ReadsWrites -> String)
-> ([ReadsWrites] -> ShowS)
-> Show ReadsWrites
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadsWrites -> ShowS
showsPrec :: Int -> ReadsWrites -> ShowS
$cshow :: ReadsWrites -> String
show :: ReadsWrites -> String
$cshowList :: [ReadsWrites] -> ShowS
showList :: [ReadsWrites] -> ShowS
Show)

-- | @since 0.9
instance Semigroup ReadsWrites where
  ReadsWrites Set ComponentID
r1 Set ComponentID
w1 <> :: ReadsWrites -> ReadsWrites -> ReadsWrites
<> ReadsWrites Set ComponentID
r2 Set ComponentID
w2 = Set ComponentID -> Set ComponentID -> ReadsWrites
ReadsWrites (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 ReadsWrites where
  mempty :: ReadsWrites
mempty = Set ComponentID -> Set ComponentID -> ReadsWrites
ReadsWrites Set ComponentID
forall a. Monoid a => a
mempty Set ComponentID
forall a. Monoid a => a
mempty

-- | `True` if the reads and writes of two `Query`s overlap.
--
-- @since 0.9
disjoint :: ReadsWrites -> ReadsWrites -> Bool
disjoint :: ReadsWrites -> ReadsWrites -> Bool
disjoint ReadsWrites
a ReadsWrites
b =
  Set ComponentID -> Set ComponentID -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.disjoint (ReadsWrites -> Set ComponentID
reads ReadsWrites
a) (ReadsWrites -> Set ComponentID
writes ReadsWrites
b)
    Bool -> Bool -> Bool
|| Set ComponentID -> Set ComponentID -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.disjoint (ReadsWrites -> Set ComponentID
reads ReadsWrites
b) (ReadsWrites -> Set ComponentID
writes ReadsWrites
a)
    Bool -> Bool -> Bool
|| Set ComponentID -> Set ComponentID -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.disjoint (ReadsWrites -> Set ComponentID
writes ReadsWrites
b) (ReadsWrites -> Set ComponentID
writes ReadsWrites
a)

-- | Match all entities.
--
-- @since 0.10
{-# INLINE all #-}
all :: Query a -> Entities -> ([a], Entities)
all :: forall a. Query a -> Entities -> ([a], Entities)
all = QueryReader a -> Entities -> ([a], Entities)
forall a. QueryReader a -> Entities -> ([a], Entities)
QR.all (QueryReader a -> Entities -> ([a], Entities))
-> (Query a -> QueryReader a)
-> Query a
-> Entities
-> ([a], Entities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query a -> QueryReader a
forall a. Query a -> QueryReader a
toReader

-- | Match all entities.
--
-- @since 0.10
{-# INLINE all' #-}
all' :: Query a -> Entities -> ([a], Components)
all' :: forall a. Query a -> Entities -> ([a], Components)
all' = QueryReader a -> Entities -> ([a], Components)
forall a. QueryReader a -> Entities -> ([a], Components)
QR.all' (QueryReader a -> Entities -> ([a], Components))
-> (Query a -> QueryReader a)
-> Query a
-> Entities
-> ([a], Components)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query a -> QueryReader a
forall a. Query a -> QueryReader a
toReader

-- | Match a single entity.
--
-- @since 0.10
{-# INLINE single #-}
single :: (HasCallStack) => Query a -> Entities -> (a, Entities)
single :: forall a. HasCallStack => Query a -> Entities -> (a, Entities)
single = QueryReader a -> Entities -> (a, Entities)
forall a.
HasCallStack =>
QueryReader a -> Entities -> (a, Entities)
QR.single (QueryReader a -> Entities -> (a, Entities))
-> (Query a -> QueryReader a)
-> Query a
-> Entities
-> (a, Entities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query a -> QueryReader a
forall a. Query a -> QueryReader a
toReader

-- | Match a single entity.
--
-- @since 0.10
{-# INLINE single' #-}
single' :: (HasCallStack) => Query a -> Entities -> (a, Components)
single' :: forall a. HasCallStack => Query a -> Entities -> (a, Components)
single' = QueryReader a -> Entities -> (a, Components)
forall a.
HasCallStack =>
QueryReader a -> Entities -> (a, Components)
QR.single' (QueryReader a -> Entities -> (a, Components))
-> (Query a -> QueryReader a)
-> Query a
-> Entities
-> (a, Components)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query a -> QueryReader a
forall a. Query a -> QueryReader a
toReader

-- | Match a single entity, or `Nothing`.
--
-- @since 0.10
{-# INLINE singleMaybe #-}
singleMaybe :: Query a -> Entities -> (Maybe a, Entities)
singleMaybe :: forall a. Query a -> Entities -> (Maybe a, Entities)
singleMaybe = QueryReader a -> Entities -> (Maybe a, Entities)
forall a. QueryReader a -> Entities -> (Maybe a, Entities)
QR.singleMaybe (QueryReader a -> Entities -> (Maybe a, Entities))
-> (Query a -> QueryReader a)
-> Query a
-> Entities
-> (Maybe a, Entities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query a -> QueryReader a
forall a. Query a -> QueryReader a
toReader

-- | Match a single entity, or `Nothing`.
--
-- @since 0.10
{-# INLINE singleMaybe' #-}
singleMaybe' :: Query a -> Entities -> (Maybe a, Components)
singleMaybe' :: forall a. Query a -> Entities -> (Maybe a, Components)
singleMaybe' = QueryReader a -> Entities -> (Maybe a, Components)
forall a. QueryReader a -> Entities -> (Maybe a, Components)
QR.singleMaybe' (QueryReader a -> Entities -> (Maybe a, Components))
-> (Query a -> QueryReader a)
-> Query a
-> Entities
-> (Maybe a, Components)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query a -> QueryReader a
forall a. Query a -> QueryReader a
toReader

-- | Map all matched entities.
--
-- @since 0.10
{-# INLINE map #-}
map :: (Monad m) => QueryT m o -> Entities -> m ([o], Entities)
map :: forall (m :: * -> *) o.
Monad m =>
QueryT m o -> Entities -> m ([o], Entities)
map QueryT m o
q Entities
es = do
  let !(ReadsWrites
rws, Components
cs', DynamicQueryT m o
dynQ) = QueryT m o
-> Components -> (ReadsWrites, Components, DynamicQueryT m o)
forall (f :: * -> *) a.
QueryT f a
-> Components -> (ReadsWrites, Components, DynamicQueryT f a)
runQuery QueryT m o
q (Components -> (ReadsWrites, Components, DynamicQueryT m o))
-> Components -> (ReadsWrites, Components, DynamicQueryT m o)
forall a b. (a -> b) -> a -> b
$ Entities -> Components
components Entities
es
      !cIds :: Set ComponentID
cIds = ReadsWrites -> Set ComponentID
reads ReadsWrites
rws Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> ReadsWrites -> Set ComponentID
writes ReadsWrites
rws
  ([o]
as, Entities
es') <- Set ComponentID
-> DynamicQueryT m o -> Entities -> m ([o], Entities)
forall (m :: * -> *) a.
Monad m =>
Set ComponentID
-> DynamicQueryT m a -> Entities -> m ([a], Entities)
mapDyn Set ComponentID
cIds DynamicQueryT m o
dynQ Entities
es
  ([o], Entities) -> m ([o], Entities)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([o]
as, Entities
es' {components = cs'})

-- | Map a single matched entity.
--
-- @since 0.10
{-# INLINE mapSingle #-}
mapSingle :: (HasCallStack, Monad m) => QueryT m a -> Entities -> m (a, Entities)
mapSingle :: forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
QueryT m a -> Entities -> m (a, Entities)
mapSingle QueryT m a
q Entities
es = do
  let !(ReadsWrites
rws, Components
cs', DynamicQueryT m a
dynQ) = QueryT m a
-> Components -> (ReadsWrites, Components, DynamicQueryT m a)
forall (f :: * -> *) a.
QueryT f a
-> Components -> (ReadsWrites, Components, DynamicQueryT f a)
runQuery QueryT m a
q (Components -> (ReadsWrites, Components, DynamicQueryT m a))
-> Components -> (ReadsWrites, Components, DynamicQueryT m a)
forall a b. (a -> b) -> a -> b
$ Entities -> Components
components Entities
es
      !cIds :: Set ComponentID
cIds = ReadsWrites -> Set ComponentID
reads ReadsWrites
rws Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> ReadsWrites -> Set ComponentID
writes ReadsWrites
rws
  (a
as, Entities
es') <- Set ComponentID -> DynamicQueryT m a -> Entities -> m (a, Entities)
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
Set ComponentID -> DynamicQueryT m a -> Entities -> m (a, Entities)
mapSingleDyn Set ComponentID
cIds DynamicQueryT m a
dynQ 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' {components = cs'})

-- | Map a single matched entity, or `Nothing`.
--
-- @since 0.10
{-# INLINE mapSingleMaybe #-}
mapSingleMaybe :: (Monad m) => QueryT m a -> Entities -> m (Maybe a, Entities)
mapSingleMaybe :: forall (m :: * -> *) a.
Monad m =>
QueryT m a -> Entities -> m (Maybe a, Entities)
mapSingleMaybe QueryT m a
q Entities
es = do
  let !(ReadsWrites
rws, Components
cs', DynamicQueryT m a
dynQ) = QueryT m a
-> Components -> (ReadsWrites, Components, DynamicQueryT m a)
forall (f :: * -> *) a.
QueryT f a
-> Components -> (ReadsWrites, Components, DynamicQueryT f a)
runQuery QueryT m a
q (Components -> (ReadsWrites, Components, DynamicQueryT m a))
-> Components -> (ReadsWrites, Components, DynamicQueryT m a)
forall a b. (a -> b) -> a -> b
$ Entities -> Components
components Entities
es
      !cIds :: Set ComponentID
cIds = ReadsWrites -> Set ComponentID
reads ReadsWrites
rws Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> ReadsWrites -> Set ComponentID
writes ReadsWrites
rws
  (Maybe a
as, Entities
es') <- Set ComponentID
-> DynamicQueryT m a -> Entities -> m (Maybe a, Entities)
forall (m :: * -> *) a.
Monad m =>
Set ComponentID
-> DynamicQueryT m a -> Entities -> m (Maybe a, Entities)
mapSingleMaybeDyn Set ComponentID
cIds DynamicQueryT m a
dynQ Entities
es
  (Maybe a, Entities) -> m (Maybe a, Entities)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
as, Entities
es' {components = cs'})