{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Mischief.ECS.World.Query where

import Control.Monad
import Control.Monad.IO.Class
import Data.Data
import Data.Foldable
import Data.Foldable hiding (and)
import Data.IORef
import Data.Map qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import GHC.Base (Int (..), eqWord#, isTrue#)
import Mischief.ECS.App.SystemDef
import Mischief.ECS.Archetypes.Graph
import Mischief.ECS.Collectable
import Mischief.ECS.Components
import Mischief.ECS.Components.BundleTypes
import Mischief.ECS.Components.Common
import Mischief.ECS.Entities
import Mischief.ECS.EntityDef
import Mischief.ECS.Log
import Mischief.ECS.Tables
import Mischief.ECS.Vec qualified as Vec
import Mischief.ECS.World
import Mischief.ECS.World.Query.Markers
import Mischief.ECS.World.Query.QueryFilter
import Mischief.ECS.World.Query.Queryable
import Mischief.ECS.World.Utils
import Prelude hiding (and)

runQuery :: forall qd m w output. (Queryable qd output, MonadSystem w m) => qd -> QueryFilter -> World -> m [output]
runQuery :: forall qd (m :: * -> *) w output.
(Queryable qd output, MonadSystem w m) =>
qd -> QueryFilter -> World -> m [output]
runQuery qd
query QueryFilter
filter World
world =
  do
    components <-
      IO [Maybe (ComponentId, ComponentQuery)]
-> m [Maybe (ComponentId, ComponentQuery)]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Maybe (ComponentId, ComponentQuery)]
 -> m [Maybe (ComponentId, ComponentQuery)])
-> IO [Maybe (ComponentId, ComponentQuery)]
-> m [Maybe (ComponentId, ComponentQuery)]
forall a b. (a -> b) -> a -> b
$
        ((TypeRep, TypeQuery) -> IO (Maybe (ComponentId, ComponentQuery)))
-> [(TypeRep, TypeQuery)]
-> IO [Maybe (ComponentId, ComponentQuery)]
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
          ( \(TypeRep
c, TypeQuery
t) -> do
              c <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
c World
world.components
              return $
                fmap
                  ( \ComponentId
c ->
                      case TypeQuery
t of
                        TypeQuery
CompQ -> (ComponentId
c, ComponentQuery
ComponentQuery)
                        TypeQuery
RelQ -> (ComponentId
c, ComponentQuery
RelationshipQueryAny)
                        RelQ' Entity
entity -> (Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
entity) ComponentId
c, ComponentQuery
RelationshipQuery)
                  )
                  c
          )
          (Set (TypeRep, TypeQuery) -> [(TypeRep, TypeQuery)]
forall a. Set a -> [a]
Set.toList (qd -> Set (TypeRep, TypeQuery)
forall qd output.
Queryable qd output =>
qd -> Set (TypeRep, TypeQuery)
queryTypes qd
query))
    archetypes <- findMatchingArchetypes (catMaybes components) world.archetypes
    let (otherFilter, archetypeFilter) = extractArchetypeFilters $ preprocessFilter filter

    archetypes' <- filterM (\([ComponentId]
components, ArchetypeId
_) -> IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (QueryFilter -> [ComponentId] -> World -> IO Bool
filterArchetype (QueryFilter -> [ComponentId] -> World -> IO Bool)
-> (QueryFilter -> QueryFilter)
-> QueryFilter
-> [ComponentId]
-> World
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryFilter -> QueryFilter
preprocessFilter) QueryFilter
archetypeFilter [ComponentId]
components World
world) archetypes

    outputs <- liftIO $ runQueryInternal query (map snd archetypes') world
    outputs' <- filterM (\(Entity
e, Bool
b, output
_) -> (Bool -> Bool -> Bool
&& Bool
b) (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
filterQuery (QueryFilter -> QueryFilter
preprocessFilter QueryFilter
otherFilter) Entity
e) outputs
    return $ map (\(Entity
_, Bool
_, output
o) -> output
o) outputs'

query :: forall qd output m w. (Queryable qd output, MonadSystem w m) => qd -> m [output]
query :: forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> m [output]
query qd
qd = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  runQuery qd NoFilter world

entityQuery :: forall qd output m w. (Queryable qd output, MonadSystem w m) => qd -> Entity -> m (Maybe output)
entityQuery :: forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> Entity -> m (Maybe output)
entityQuery qd
qd Entity
entity = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  liftIO $ runQueryEntity qd world entity

get :: forall qd m w out. (Queryable qd out, MonadSystem w m) => qd -> Entity -> m (Maybe out)
get :: forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get = qd -> Entity -> m (Maybe out)
forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> Entity -> m (Maybe output)
entityQuery

get' :: forall qd m w out qf. (Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) => qd -> qf -> Entity -> m (Maybe out)
get' :: forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> Entity -> m (Maybe out)
get' qd
qd qf
qf Entity
entity = do
  b <- QueryFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
filterQuery (QueryFilter -> QueryFilter
preprocessFilter (QueryFilter -> QueryFilter) -> QueryFilter -> QueryFilter
forall a b. (a -> b) -> a -> b
$ qf -> QueryFilter
forall v storage. Collectable v storage => v -> storage
collect qf
qf) Entity
entity
  if b
    then
      entityQuery qd entity
    else
      pure Nothing

query' :: forall qd m w out qf. (Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) => qd -> qf -> m [out]
query' :: forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> m [out]
query' qd
qd qf
filter = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  runQuery qd (collect filter) world

single :: forall qd m w out. (Queryable qd out, MonadSystem w m) => qd -> m (Maybe out)
single :: forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> m (Maybe out)
single qd
qd = do
  res <- qd -> m [out]
forall qd output (m :: * -> *) w.
(Queryable qd output, MonadSystem w m) =>
qd -> m [output]
query qd
qd
  case res of
    [out
x] -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe out -> m (Maybe out)) -> Maybe out -> m (Maybe out)
forall a b. (a -> b) -> a -> b
$ out -> Maybe out
forall a. a -> Maybe a
Just out
x
    [out]
_ -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe out
forall a. Maybe a
Nothing

single' :: forall qd m w out qf. (Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) => qd -> qf -> m (Maybe out)
single' :: forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> m (Maybe out)
single' qd
qd qf
filter = do
  res <- qd -> qf -> m [out]
forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> m [out]
query' qd
qd qf
filter
  case res of
    [out
x] -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe out -> m (Maybe out)) -> Maybe out -> m (Maybe out)
forall a b. (a -> b) -> a -> b
$ out -> Maybe out
forall a. a -> Maybe a
Just out
x
    [out]
_ -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe out
forall a. Maybe a
Nothing

-- iter :: forall qd m w. (Queryable qd, MonadSystem w m) => (QueryOutput qd -> m ()) -> m ()
-- iter system = do
--   res <- query @qd
--   for_ res system

-- iter' :: forall qd m w. (Queryable qd, MonadSystem w m) => QueryFilter -> (QueryOutput qd -> m ()) -> m ()
-- iter' filter system = do
--   res <- query' @qd filter
--   for_ res system

-- parIter :: forall qd m w. (Queryable qd, MonadSystem w m) => (QueryOutput qd -> ParSystem ()) -> m ()
-- parIter system = do
--   res <- query @qd
--   parIterList res $ \chunk -> for_ chunk system

class GetResultComponentId c where
  getResultComponentId :: (MonadSystem w m) => c -> m (Maybe ComponentId)

class GetResultComponentId' flag c where
  getResultComponentId' :: (MonadSystem w m) => c -> m (Maybe ComponentId)

instance (Component c) => GetResultComponentId' True (Result c) where
  getResultComponentId' :: forall w (m :: * -> *).
MonadSystem w m =>
Result c -> m (Maybe ComponentId)
getResultComponentId' Result c
_ = (Entity -> ComponentId) -> Maybe Entity -> Maybe ComponentId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Entity (# Word#
id, Word#
_ #)) -> (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
id, Maybe Entity
forall a. Maybe a
Nothing #)) (Maybe Entity -> Maybe ComponentId)
-> m (Maybe Entity) -> m (Maybe ComponentId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
m (Maybe Entity)
tryMetaLocal @c

instance (Component c) => GetResultComponentId' False (Result (Rel c)) where
  getResultComponentId' :: forall w (m :: * -> *).
MonadSystem w m =>
Result (Rel c) -> m (Maybe ComponentId)
getResultComponentId' Result (Rel c)
r = (Entity -> ComponentId) -> Maybe Entity -> Maybe ComponentId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Entity (# Word#
id, Word#
_ #)) -> (# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
id, Entity -> Maybe Entity
forall a. a -> Maybe a
Just Result (Rel c)
r.target #)) (Maybe Entity -> Maybe ComponentId)
-> m (Maybe Entity) -> m (Maybe ComponentId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
m (Maybe Entity)
tryMetaLocal @c

tryMetaLocal :: forall c m w. (Component c, MonadSystem w m) => m (Maybe Entity)
tryMetaLocal :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
m (Maybe Entity)
tryMetaLocal = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  component <- liftIO $ getComponentId (typeRep $ Proxy @c) world.components
  return $ fmap (\(ComponentId (# Word#
id, Maybe Entity
_ #)) -> (# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #)) component

instance (GetResultComponentId' (IsComp c) (Result c)) => GetResultComponentId (Result c) where
  getResultComponentId :: forall w (m :: * -> *).
MonadSystem w m =>
Result c -> m (Maybe ComponentId)
getResultComponentId = forall (flag :: Bool) c w (m :: * -> *).
(GetResultComponentId' flag c, MonadSystem w m) =>
c -> m (Maybe ComponentId)
forall {k} (flag :: k) c w (m :: * -> *).
(GetResultComponentId' flag c, MonadSystem w m) =>
c -> m (Maybe ComponentId)
getResultComponentId' @(IsComp c)

addedChanged :: forall c m w. (MonadSystem w m, GetResultComponentId (Result c)) => (ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
addedChanged :: forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
(ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
f Result c
r = do
  id <- Result c -> m (Maybe ComponentId)
forall c w (m :: * -> *).
(GetResultComponentId c, MonadSystem w m) =>
c -> m (Maybe ComponentId)
forall w (m :: * -> *).
MonadSystem w m =>
Result c -> m (Maybe ComponentId)
getResultComponentId Result c
r
  case id of
    Maybe ComponentId
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just ComponentId
id -> do
      world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
      ticks <- liftIO $ tryGetEntityTicks (entityOf r) id world
      case ticks of
        Maybe ComponentTicks
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just ComponentTicks
ticks -> do
          (lastSystemTick, currentSystemTick) <- IO (Tick, Tick) -> m (Tick, Tick)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tick, Tick) -> m (Tick, Tick))
-> IO (Tick, Tick) -> m (Tick, Tick)
forall a b. (a -> b) -> a -> b
$ World -> IO (Tick, Tick)
getSystemTicksInternal World
world
          return $ f ticks lastSystemTick currentSystemTick

added :: forall c m w. (MonadSystem w m, GetResultComponentId (Result c)) => Result c -> m Bool
added :: forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
Result c -> m Bool
added = (ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
(ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
qfAddedF

changed :: forall c m w. (MonadSystem w m, GetResultComponentId (Result c)) => Result c -> m Bool
changed :: forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
Result c -> m Bool
changed = (ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
forall c (m :: * -> *) w.
(MonadSystem w m, GetResultComponentId (Result c)) =>
(ComponentTicks -> Tick -> Tick -> Bool) -> Result c -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
qfChangedF