{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- |
-- Module      : Aztecs.ECS.System
-- 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.System.Dynamic
  ( -- * Dynamic systems
    DynamicSystem (..),
    runDynamicSystem,

    -- ** Queries
    runQuery,
    runQueryFiltered,
    runQuerySingle,
    runQuerySingleMaybe,
    readQuery,
    readQueryFiltered,
    readQuerySingle,
    readQuerySingleMaybe,
  )
where

import Aztecs.ECS.Access.Internal (Access)
import Aztecs.ECS.Component
import Aztecs.ECS.Query.Dynamic (DynamicQuery)
import qualified Aztecs.ECS.Query.Dynamic as DQ
import Aztecs.ECS.World.Archetypes (Node (..))
import Aztecs.ECS.World.Entities (Entities)
import Data.Set (Set)
import Data.Vector (Vector)
import Prelude hiding (all, filter, map, mapM)

-- | Query operation.
data Op m a where
  RunQuery :: DynamicQuery m a -> Op m (Vector a)
  RunFiltered :: (Node m -> Bool) -> DynamicQuery m a -> Op m (Vector a)
  RunQuerySingle :: DynamicQuery m a -> Op m a
  RunQuerySingleMaybe :: DynamicQuery m a -> Op m (Maybe a)
  ReadQuery :: DynamicQuery m a -> Op m (Vector a)
  ReadQueryFiltered :: DynamicQuery m a -> (Node m -> Bool) -> Op m (Vector a)
  ReadQuerySingle :: DynamicQuery m a -> Op m a
  ReadQuerySingleMaybe :: DynamicQuery m a -> Op m (Maybe a)

-- | Run a query operation on entities.
runOp :: (Monad m) => Set ComponentID -> Op m a -> Entities m -> m (a, Entities m, Access m ())
runOp :: forall (m :: * -> *) a.
Monad m =>
Set ComponentID
-> Op m a -> Entities m -> m (a, Entities m, Access m ())
runOp Set ComponentID
cIds (RunQuery DynamicQuery m a
q) Entities m
es = Set ComponentID
-> DynamicQuery m a
-> Entities m
-> m (Vector a, Entities m, Access m ())
forall (m :: * -> *) a.
Monad m =>
Set ComponentID
-> DynamicQuery m a
-> Entities m
-> m (Vector a, Entities m, Access m ())
DQ.runQueryDyn Set ComponentID
cIds DynamicQuery m a
q Entities m
es
runOp Set ComponentID
cIds (RunFiltered Node m -> Bool
flt DynamicQuery m a
q) Entities m
es = Set ComponentID
-> (Node m -> Bool)
-> DynamicQuery m a
-> Entities m
-> m (Vector a, Entities m, Access m ())
forall (m :: * -> *) a.
Monad m =>
Set ComponentID
-> (Node m -> Bool)
-> DynamicQuery m a
-> Entities m
-> m (Vector a, Entities m, Access m ())
DQ.runQueryFilteredDyn Set ComponentID
cIds Node m -> Bool
flt DynamicQuery m a
q Entities m
es
runOp Set ComponentID
cIds (RunQuerySingle DynamicQuery m a
q) Entities m
es = Set ComponentID
-> DynamicQuery m a -> Entities m -> m (a, Entities m, Access m ())
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
Set ComponentID
-> DynamicQuery m a -> Entities m -> m (a, Entities m, Access m ())
DQ.runQuerySingleDyn Set ComponentID
cIds DynamicQuery m a
q Entities m
es
runOp Set ComponentID
cIds (RunQuerySingleMaybe DynamicQuery m a
q) Entities m
es = Set ComponentID
-> DynamicQuery m a
-> Entities m
-> m (Maybe a, Entities m, Access m ())
forall (m :: * -> *) a.
Monad m =>
Set ComponentID
-> DynamicQuery m a
-> Entities m
-> m (Maybe a, Entities m, Access m ())
DQ.runQuerySingleMaybeDyn Set ComponentID
cIds DynamicQuery m a
q Entities m
es
runOp Set ComponentID
cIds (ReadQuery DynamicQuery m a
q) Entities m
es = do
  Vector a
as <- Set ComponentID -> DynamicQuery m a -> Entities m -> m (Vector a)
forall (m :: * -> *) a.
Monad m =>
Set ComponentID -> DynamicQuery m a -> Entities m -> m (Vector a)
DQ.readQueryDyn Set ComponentID
cIds DynamicQuery m a
q Entities m
es
  (a, Entities m, Access m ()) -> m (a, Entities m, Access m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
Vector a
as, Entities m
es, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
runOp Set ComponentID
cIds (ReadQueryFiltered DynamicQuery m a
q Node m -> Bool
flt) Entities m
es = do
  Vector a
as <- Set ComponentID
-> (Node m -> Bool)
-> DynamicQuery m a
-> Entities m
-> m (Vector a)
forall (m :: * -> *) a.
Monad m =>
Set ComponentID
-> (Node m -> Bool)
-> DynamicQuery m a
-> Entities m
-> m (Vector a)
DQ.readQueryFilteredDyn Set ComponentID
cIds Node m -> Bool
flt DynamicQuery m a
q Entities m
es
  (a, Entities m, Access m ()) -> m (a, Entities m, Access m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
Vector a
as, Entities m
es, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
runOp Set ComponentID
cIds (ReadQuerySingle DynamicQuery m a
q) Entities m
es = do
  a
a <- Set ComponentID -> DynamicQuery m a -> Entities m -> m a
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
Set ComponentID -> DynamicQuery m a -> Entities m -> m a
DQ.readQuerySingleDyn Set ComponentID
cIds DynamicQuery m a
q Entities m
es
  (a, Entities m, Access m ()) -> m (a, Entities m, Access m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Entities m
es, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
runOp Set ComponentID
cIds (ReadQuerySingleMaybe DynamicQuery m a
q) Entities m
es = do
  Maybe a
a <- Set ComponentID -> DynamicQuery m a -> Entities m -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
Set ComponentID -> DynamicQuery m a -> Entities m -> m (Maybe a)
DQ.readQuerySingleMaybeDyn Set ComponentID
cIds DynamicQuery m a
q Entities m
es
  (a, Entities m, Access m ()) -> m (a, Entities m, Access m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
Maybe a
a, Entities m
es, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE runOp #-}

-- | Dynamic system.
data DynamicSystem m a where
  -- | Pure value.
  Pure :: a -> DynamicSystem m a
  -- | Functor map.
  Map :: (b -> a) -> DynamicSystem m b -> DynamicSystem m a
  -- | Applicative apply.
  Ap :: DynamicSystem m (b -> a) -> DynamicSystem m b -> DynamicSystem m a
  -- | Query operation.
  Op :: Set ComponentID -> Op m a -> DynamicSystem m a

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

instance Applicative (DynamicSystem m) where
  pure :: forall a. a -> DynamicSystem m a
pure = a -> DynamicSystem m a
forall a (m :: * -> *). a -> DynamicSystem m a
Pure
  {-# INLINE pure #-}

  Pure a -> b
f <*> :: forall a b.
DynamicSystem m (a -> b) -> DynamicSystem m a -> DynamicSystem m b
<*> DynamicSystem m a
s = (a -> b) -> DynamicSystem m a -> DynamicSystem m b
forall a b. (a -> b) -> DynamicSystem m a -> DynamicSystem m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f DynamicSystem m a
s
  DynamicSystem m (a -> b)
f <*> Pure a
a = ((a -> b) -> b) -> DynamicSystem m (a -> b) -> DynamicSystem m b
forall a b. (a -> b) -> DynamicSystem m a -> DynamicSystem m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) DynamicSystem m (a -> b)
f
  DynamicSystem m (a -> b)
f <*> DynamicSystem m a
s = DynamicSystem m (a -> b) -> DynamicSystem m a -> DynamicSystem m b
forall (m :: * -> *) a b.
DynamicSystem m (a -> b) -> DynamicSystem m a -> DynamicSystem m b
Ap DynamicSystem m (a -> b)
f DynamicSystem m a
s
  {-# INLINE (<*>) #-}

-- | Run a dynamic system on entities, returning results, updated entities, and hooks to run.
runDynamicSystem :: (Monad m) => DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())
runDynamicSystem :: forall (m :: * -> *) a.
Monad m =>
DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())
runDynamicSystem (Pure a
a) Entities m
es = (a, Entities m, Access m ()) -> m (a, Entities m, Access m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Entities m
es, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
runDynamicSystem (Map b -> a
f DynamicSystem m b
s) Entities m
es = do
  (b
b, Entities m
es', Access m ()
hook) <- DynamicSystem m b -> Entities m -> m (b, Entities m, Access m ())
forall (m :: * -> *) a.
Monad m =>
DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())
runDynamicSystem DynamicSystem m b
s Entities m
es
  (a, Entities m, Access m ()) -> m (a, Entities m, Access m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> a
f b
b, Entities m
es', Access m ()
hook)
runDynamicSystem (Ap DynamicSystem m (b -> a)
sf DynamicSystem m b
sa) Entities m
es = do
  (b -> a
f, Entities m
es', Access m ()
hook1) <- DynamicSystem m (b -> a)
-> Entities m -> m (b -> a, Entities m, Access m ())
forall (m :: * -> *) a.
Monad m =>
DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())
runDynamicSystem DynamicSystem m (b -> a)
sf Entities m
es
  (b
a, Entities m
es'', Access m ()
hook2) <- DynamicSystem m b -> Entities m -> m (b, Entities m, Access m ())
forall (m :: * -> *) a.
Monad m =>
DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())
runDynamicSystem DynamicSystem m b
sa Entities m
es'
  (a, Entities m, Access m ()) -> m (a, Entities m, Access m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> a
f b
a, Entities m
es'', Access m ()
hook1 Access m () -> Access m () -> Access m ()
forall a b. Access m a -> Access m b -> Access m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Access m ()
hook2)
runDynamicSystem (Op Set ComponentID
cIds Op m a
op) Entities m
es = Set ComponentID
-> Op m a -> Entities m -> m (a, Entities m, Access m ())
forall (m :: * -> *) a.
Monad m =>
Set ComponentID
-> Op m a -> Entities m -> m (a, Entities m, Access m ())
runOp Set ComponentID
cIds Op m a
op Entities m
es
{-# INLINE runDynamicSystem #-}

runQuery :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Vector a)
runQuery :: forall (m :: * -> *) a.
Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Vector a)
runQuery Set ComponentID
cIds DynamicQuery m a
q = Set ComponentID -> Op m (Vector a) -> DynamicSystem m (Vector a)
forall (m :: * -> *) a.
Set ComponentID -> Op m a -> DynamicSystem m a
Op Set ComponentID
cIds (DynamicQuery m a -> Op m (Vector a)
forall (m :: * -> *) a. DynamicQuery m a -> Op m (Vector a)
RunQuery DynamicQuery m a
q)
{-# INLINE runQuery #-}

runQueryFiltered :: Set ComponentID -> DynamicQuery m a -> (Node m -> Bool) -> DynamicSystem m (Vector a)
runQueryFiltered :: forall (m :: * -> *) a.
Set ComponentID
-> DynamicQuery m a
-> (Node m -> Bool)
-> DynamicSystem m (Vector a)
runQueryFiltered Set ComponentID
cIds DynamicQuery m a
q Node m -> Bool
flt = Set ComponentID -> Op m (Vector a) -> DynamicSystem m (Vector a)
forall (m :: * -> *) a.
Set ComponentID -> Op m a -> DynamicSystem m a
Op Set ComponentID
cIds ((Node m -> Bool) -> DynamicQuery m a -> Op m (Vector a)
forall (m :: * -> *) a.
(Node m -> Bool) -> DynamicQuery m a -> Op m (Vector a)
RunFiltered Node m -> Bool
flt DynamicQuery m a
q)
{-# INLINE runQueryFiltered #-}

runQuerySingle :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m a
runQuerySingle :: forall (m :: * -> *) a.
Set ComponentID -> DynamicQuery m a -> DynamicSystem m a
runQuerySingle Set ComponentID
cIds DynamicQuery m a
q = Set ComponentID -> Op m a -> DynamicSystem m a
forall (m :: * -> *) a.
Set ComponentID -> Op m a -> DynamicSystem m a
Op Set ComponentID
cIds (DynamicQuery m a -> Op m a
forall (m :: * -> *) a. DynamicQuery m a -> Op m a
RunQuerySingle DynamicQuery m a
q)
{-# INLINE runQuerySingle #-}

runQuerySingleMaybe :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Maybe a)
runQuerySingleMaybe :: forall (m :: * -> *) a.
Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Maybe a)
runQuerySingleMaybe Set ComponentID
cIds DynamicQuery m a
q = Set ComponentID -> Op m (Maybe a) -> DynamicSystem m (Maybe a)
forall (m :: * -> *) a.
Set ComponentID -> Op m a -> DynamicSystem m a
Op Set ComponentID
cIds (DynamicQuery m a -> Op m (Maybe a)
forall (m :: * -> *) a. DynamicQuery m a -> Op m (Maybe a)
RunQuerySingleMaybe DynamicQuery m a
q)
{-# INLINE runQuerySingleMaybe #-}

readQuery :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Vector a)
readQuery :: forall (m :: * -> *) a.
Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Vector a)
readQuery Set ComponentID
cIds DynamicQuery m a
q = Set ComponentID -> Op m (Vector a) -> DynamicSystem m (Vector a)
forall (m :: * -> *) a.
Set ComponentID -> Op m a -> DynamicSystem m a
Op Set ComponentID
cIds (DynamicQuery m a -> Op m (Vector a)
forall (m :: * -> *) a. DynamicQuery m a -> Op m (Vector a)
ReadQuery DynamicQuery m a
q)
{-# INLINE readQuery #-}

readQueryFiltered :: Set ComponentID -> (Node m -> Bool) -> DynamicQuery m a -> DynamicSystem m (Vector a)
readQueryFiltered :: forall (m :: * -> *) a.
Set ComponentID
-> (Node m -> Bool)
-> DynamicQuery m a
-> DynamicSystem m (Vector a)
readQueryFiltered Set ComponentID
cIds Node m -> Bool
flt DynamicQuery m a
q = Set ComponentID -> Op m (Vector a) -> DynamicSystem m (Vector a)
forall (m :: * -> *) a.
Set ComponentID -> Op m a -> DynamicSystem m a
Op Set ComponentID
cIds (DynamicQuery m a -> (Node m -> Bool) -> Op m (Vector a)
forall (m :: * -> *) a.
DynamicQuery m a -> (Node m -> Bool) -> Op m (Vector a)
ReadQueryFiltered DynamicQuery m a
q Node m -> Bool
flt)
{-# INLINE readQueryFiltered #-}

readQuerySingle :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m a
readQuerySingle :: forall (m :: * -> *) a.
Set ComponentID -> DynamicQuery m a -> DynamicSystem m a
readQuerySingle Set ComponentID
cIds DynamicQuery m a
q = Set ComponentID -> Op m a -> DynamicSystem m a
forall (m :: * -> *) a.
Set ComponentID -> Op m a -> DynamicSystem m a
Op Set ComponentID
cIds (DynamicQuery m a -> Op m a
forall (m :: * -> *) a. DynamicQuery m a -> Op m a
ReadQuerySingle DynamicQuery m a
q)

readQuerySingleMaybe :: Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Maybe a)
readQuerySingleMaybe :: forall (m :: * -> *) a.
Set ComponentID -> DynamicQuery m a -> DynamicSystem m (Maybe a)
readQuerySingleMaybe Set ComponentID
cIds DynamicQuery m a
q = Set ComponentID -> Op m (Maybe a) -> DynamicSystem m (Maybe a)
forall (m :: * -> *) a.
Set ComponentID -> Op m a -> DynamicSystem m a
Op Set ComponentID
cIds (DynamicQuery m a -> Op m (Maybe a)
forall (m :: * -> *) a. DynamicQuery m a -> Op m (Maybe a)
ReadQuerySingleMaybe DynamicQuery m a
q)
{-# INLINE readQuerySingleMaybe #-}