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

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

    -- ** Running
    all,
    all',
    single,
    single',
    singleMaybe,
    singleMaybe',

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

import Aztecs.ECS.Component
import Aztecs.ECS.Query.Dynamic.Reader
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 qualified Aztecs.ECS.World.Entities as E
import Control.Monad.Identity
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Stack
import Prelude hiding (all)

-- | Query to read from entities.
--
-- @since 0.10
newtype QueryReader a
  = QueryReader
  { -- | Run a query reader.
    --
    -- @since 0.10
    forall a.
QueryReader a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader a)
runQueryReader :: Components -> (Set ComponentID, Components, DynamicQueryReader a)
  }
  deriving ((forall a b. (a -> b) -> QueryReader a -> QueryReader b)
-> (forall a b. a -> QueryReader b -> QueryReader a)
-> Functor QueryReader
forall a b. a -> QueryReader b -> QueryReader a
forall a b. (a -> b) -> QueryReader a -> QueryReader b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> QueryReader a -> QueryReader b
fmap :: forall a b. (a -> b) -> QueryReader a -> QueryReader b
$c<$ :: forall a b. a -> QueryReader b -> QueryReader a
<$ :: forall a b. a -> QueryReader b -> QueryReader a
Functor)

-- | @since 0.10
instance Applicative QueryReader where
  pure :: forall a. a -> QueryReader a
pure a
a = (Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
forall a.
(Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
QueryReader (Set ComponentID
forall a. Monoid a => a
mempty,,a -> DynamicQueryReader a
forall a. a -> DynamicQueryReader a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
  {-# INLINE pure #-}

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

-- | @since 0.10
instance QueryReaderF QueryReader where
  fetch :: forall a. (Component a) => QueryReader a
  fetch :: forall a. Component a => QueryReader a
fetch = (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 !(ComponentID
cId, Components
cs') = forall a. Component a => Components -> (ComponentID, Components)
CS.insert @a Components
cs in (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId, Components
cs', ComponentID -> DynamicQueryReader a
forall a. Component a => ComponentID -> DynamicQueryReader a
forall (f :: * -> *) a.
(DynamicQueryReaderF f, Component a) =>
ComponentID -> f a
fetchDyn ComponentID
cId)
  {-# INLINE fetch #-}

  fetchMaybe :: forall a. (Component a) => QueryReader (Maybe a)
  fetchMaybe :: forall a. Component a => QueryReader (Maybe a)
fetchMaybe = (Components
 -> (Set ComponentID, Components, DynamicQueryReader (Maybe a)))
-> QueryReader (Maybe a)
forall a.
(Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
QueryReader ((Components
  -> (Set ComponentID, Components, DynamicQueryReader (Maybe a)))
 -> QueryReader (Maybe a))
-> (Components
    -> (Set ComponentID, Components, DynamicQueryReader (Maybe a)))
-> QueryReader (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let !(ComponentID
cId, Components
cs') = forall a. Component a => Components -> (ComponentID, Components)
CS.insert @a Components
cs in (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId, Components
cs', ComponentID -> DynamicQueryReader (Maybe a)
forall a.
Component a =>
ComponentID -> DynamicQueryReader (Maybe a)
forall (f :: * -> *) a.
(DynamicQueryReaderF f, Component a) =>
ComponentID -> f (Maybe a)
fetchMaybeDyn ComponentID
cId)
  {-# INLINE fetchMaybe #-}

-- | @since 0.10
instance DynamicQueryReaderF QueryReader where
  {-# INLINE entity #-}
  entity :: QueryReader EntityID
entity = (Components
 -> (Set ComponentID, Components, DynamicQueryReader EntityID))
-> QueryReader EntityID
forall a.
(Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
QueryReader (Set ComponentID
forall a. Monoid a => a
mempty,,DynamicQueryReader EntityID
forall (f :: * -> *). DynamicQueryReaderF f => f EntityID
entity)
  {-# INLINE fetchDyn #-}
  fetchDyn :: forall a. Component a => ComponentID -> QueryReader a
fetchDyn ComponentID
cId = (Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
forall a.
(Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
QueryReader (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId,,ComponentID -> DynamicQueryReader a
forall a. Component a => ComponentID -> DynamicQueryReader a
forall (f :: * -> *) a.
(DynamicQueryReaderF f, Component a) =>
ComponentID -> f a
fetchDyn ComponentID
cId)
  {-# INLINE fetchMaybeDyn #-}
  fetchMaybeDyn :: forall a. Component a => ComponentID -> QueryReader (Maybe a)
fetchMaybeDyn ComponentID
cId = (Components
 -> (Set ComponentID, Components, DynamicQueryReader (Maybe a)))
-> QueryReader (Maybe a)
forall a.
(Components -> (Set ComponentID, Components, DynamicQueryReader a))
-> QueryReader a
QueryReader (ComponentID -> Set ComponentID
forall a. a -> Set a
Set.singleton ComponentID
cId,,ComponentID -> DynamicQueryReader (Maybe a)
forall a.
Component a =>
ComponentID -> DynamicQueryReader (Maybe a)
forall (f :: * -> *) a.
(DynamicQueryReaderF f, Component a) =>
ComponentID -> f (Maybe a)
fetchMaybeDyn ComponentID
cId)

-- | Filter for a `Query`.
--
-- @since 0.9
newtype QueryFilter = QueryFilter
  { -- | Run a query filter.
    QueryFilter -> Components -> (DynamicQueryFilter, Components)
runQueryFilter :: Components -> (DynamicQueryFilter, Components)
  }

-- | @since 0.9
instance Semigroup QueryFilter where
  QueryFilter
a <> :: QueryFilter -> QueryFilter -> QueryFilter
<> QueryFilter
b =
    (Components -> (DynamicQueryFilter, Components)) -> QueryFilter
QueryFilter
      ( \Components
cs ->
          let !(DynamicQueryFilter
withA', Components
cs') = QueryFilter -> Components -> (DynamicQueryFilter, Components)
runQueryFilter QueryFilter
a Components
cs
              !(DynamicQueryFilter
withB', Components
cs'') = QueryFilter -> Components -> (DynamicQueryFilter, Components)
runQueryFilter QueryFilter
b Components
cs'
           in (DynamicQueryFilter
withA' DynamicQueryFilter -> DynamicQueryFilter -> DynamicQueryFilter
forall a. Semigroup a => a -> a -> a
<> DynamicQueryFilter
withB', Components
cs'')
      )

-- | @since 0.9
instance Monoid QueryFilter where
  mempty :: QueryFilter
mempty = (Components -> (DynamicQueryFilter, Components)) -> QueryFilter
QueryFilter (DynamicQueryFilter
forall a. Monoid a => a
mempty,)

-- | Filter for entities containing this component.
--
-- @since 0.9
with :: forall a. (Component a) => QueryFilter
with :: forall a. Component a => QueryFilter
with = (Components -> (DynamicQueryFilter, Components)) -> QueryFilter
QueryFilter ((Components -> (DynamicQueryFilter, Components)) -> QueryFilter)
-> (Components -> (DynamicQueryFilter, Components)) -> QueryFilter
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let !(ComponentID
cId, Components
cs') = forall a. Component a => Components -> (ComponentID, Components)
CS.insert @a Components
cs in (DynamicQueryFilter
forall a. Monoid a => a
mempty {filterWith = Set.singleton cId}, Components
cs')

-- | Filter out entities containing this component.
--
-- @since 0.9
without :: forall a. (Component a) => QueryFilter
without :: forall a. Component a => QueryFilter
without = (Components -> (DynamicQueryFilter, Components)) -> QueryFilter
QueryFilter ((Components -> (DynamicQueryFilter, Components)) -> QueryFilter)
-> (Components -> (DynamicQueryFilter, Components)) -> QueryFilter
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
  let !(ComponentID
cId, Components
cs') = forall a. Component a => Components -> (ComponentID, Components)
CS.insert @a Components
cs in (DynamicQueryFilter
forall a. Monoid a => a
mempty {filterWithout = Set.singleton cId}, Components
cs')

-- | Match all entities.
--
-- @since 0.10
{-# INLINE all #-}
all :: QueryReader a -> Entities -> ([a], Entities)
all :: forall a. QueryReader a -> Entities -> ([a], Entities)
all QueryReader a
q Entities
es = let !([a]
as, Components
cs) = QueryReader a -> Entities -> ([a], Components)
forall a. QueryReader a -> Entities -> ([a], Components)
all' QueryReader a
q Entities
es in ([a]
as, Entities
es {E.components = cs})

-- | Match all entities.
--
-- @since 0.10
{-# INLINE all' #-}
all' :: QueryReader a -> Entities -> ([a], Components)
all' :: forall a. QueryReader a -> Entities -> ([a], Components)
all' QueryReader a
q Entities
es = let !(Set ComponentID
rs, Components
cs', DynamicQueryReader a
dynQ) = QueryReader a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader a)
forall a.
QueryReader a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader a)
runQueryReader QueryReader a
q (Entities -> Components
E.components Entities
es) in (Set ComponentID -> DynamicQueryReader a -> Entities -> [a]
forall a.
Set ComponentID -> DynamicQueryReader a -> Entities -> [a]
allDyn Set ComponentID
rs DynamicQueryReader a
dynQ Entities
es, Components
cs')

-- | Match a single entity.
--
-- @since 0.10
{-# INLINE single #-}
single :: (HasCallStack) => QueryReader a -> Entities -> (a, Entities)
single :: forall a.
HasCallStack =>
QueryReader a -> Entities -> (a, Entities)
single QueryReader a
q Entities
es = let !(a
a, Components
cs) = QueryReader a -> Entities -> (a, Components)
forall a.
HasCallStack =>
QueryReader a -> Entities -> (a, Components)
single' QueryReader a
q Entities
es in (a
a, Entities
es {E.components = cs})

-- | Match a single entity.
--
-- @since 0.10
{-# INLINE single' #-}
single' :: (HasCallStack) => QueryReader a -> Entities -> (a, Components)
single' :: forall a.
HasCallStack =>
QueryReader a -> Entities -> (a, Components)
single' QueryReader a
q Entities
es = let !(Set ComponentID
rs, Components
cs', DynamicQueryReader a
dynQ) = QueryReader a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader a)
forall a.
QueryReader a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader a)
runQueryReader QueryReader a
q (Entities -> Components
E.components Entities
es) in (Set ComponentID -> DynamicQueryReader a -> Entities -> a
forall a.
HasCallStack =>
Set ComponentID -> DynamicQueryReader a -> Entities -> a
singleDyn Set ComponentID
rs DynamicQueryReader a
dynQ Entities
es, Components
cs')

-- | Match a single entity.
--
-- @since 0.10
{-# INLINE singleMaybe #-}
singleMaybe :: QueryReader a -> Entities -> (Maybe a, Entities)
singleMaybe :: forall a. QueryReader a -> Entities -> (Maybe a, Entities)
singleMaybe QueryReader a
q Entities
es = let !(Maybe a
a, Components
cs) = QueryReader a -> Entities -> (Maybe a, Components)
forall a. QueryReader a -> Entities -> (Maybe a, Components)
singleMaybe' QueryReader a
q Entities
es in (Maybe a
a, Entities
es {E.components = cs})

-- | Match a single entity.
--
-- @since 0.10
{-# INLINE singleMaybe' #-}
singleMaybe' :: QueryReader a -> Entities -> (Maybe a, Components)
singleMaybe' :: forall a. QueryReader a -> Entities -> (Maybe a, Components)
singleMaybe' QueryReader a
q Entities
es = let !(Set ComponentID
rs, Components
cs', DynamicQueryReader a
dynQ) = QueryReader a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader a)
forall a.
QueryReader a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader a)
runQueryReader QueryReader a
q (Entities -> Components
E.components Entities
es) in (Set ComponentID -> DynamicQueryReader a -> Entities -> Maybe a
forall a.
Set ComponentID -> DynamicQueryReader a -> Entities -> Maybe a
singleMaybeDyn Set ComponentID
rs DynamicQueryReader a
dynQ Entities
es, Components
cs')