{-# 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.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Traversable
import Mischief.ECS.Archetypes.Graph
import Mischief.ECS.Components
import Mischief.ECS.Entities
import Mischief.ECS.Tables (Tables (Tables))
import Mischief.ECS.Vec qualified as Vec
import Mischief.ECS.World
import Mischief.ECS.World.Par (parFor')
import Mischief.ECS.World.Query.Markers
import Mischief.ECS.World.Query.QueryFilter
import Mischief.ECS.World.Query.Queryable
import Prelude hiding (and)

findArchetypes :: forall qd m w output. (Queryable qd output, MonadSystem w m) => qd -> m (Set ArchetypeId)
findArchetypes :: forall qd (m :: * -> *) w output.
(Queryable qd output, MonadSystem w m) =>
qd -> m (Set ArchetypeId)
findArchetypes !qd
query = do
  !world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  !components <-
    liftIO $
      mapM
        ( \(!TypeRep
c, !TypeQuery
t) -> do
            !c <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
c World
world.components
            pure $
              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.toList (queryTypes query))

  findMatchingArchetypes (catMaybes components)

-- runQuery :: forall qd m w output a. (Queryable qd output, MonadSystem w m) => qd -> QueryFilter -> World -> m [output]
-- runQuery query filter world =
--   do
--     archetypes <- findArchetypes query
--     -- let (otherFilter, archetypeFilter) = extractArchetypeFilters $ preprocessFilter filter

--     -- archetypes' <- filterM (\(components, _) -> liftIO $ (filterArchetype . preprocessFilter) archetypeFilter components world) archetypes

--     -- outputs <- liftIO $ runQueryInternal query (map snd archetypes') world
--     -- outputs' <- filterM (\(e, b, _) -> (&& b) <$> filterQuery (preprocessFilter otherFilter) e) outputs
--     -- return $ map (\(_, _, o) -> o) outputs'
--     undefined

-- query :: forall qd output m w. (Queryable qd output, MonadSystem w m) => qd -> m [output]
-- query qd = do
--   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 = entityQuery

-- get' :: forall qd m w out qf. (Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) => qd -> qf -> Entity -> m (Maybe out)
-- get' qd qf entity = do
--   b <- filterQuery (preprocessFilter $ collect qf) 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' qd filter = do
--   world <- unsafeGetWorld
--   runQuery qd (collect filter) world

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

-- single' :: forall qd m w out qf. (Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) => qd -> qf -> m (Maybe out)
-- single' qd filter = do
--   res <- query' qd filter
--   case res of
--     [x] -> return $ Just x
--     _ -> return 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 GetComponentId c where
  getComponentId' :: (MonadSystem w m) => c -> FilterComponent

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
  pure $ fmap (\(ComponentId (# !Word#
id, Maybe Entity
_ #)) -> (# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #)) component

--   getComponentId' _ =

-- instance (Component c) => GetComponentId (R c Entity) where
--   getComponentId' (R e) = fmap (\(Entity (# id, _ #)) -> ComponentId (# id, Just e #)) <$
-- instance {-# OVERLAPPING #-} (Component c) => GetComponentId (C c) where> tryMetaLocal @c

-- instance (GetResultComponentId' (IsComp c) (Result c)) => GetResultComponentId (Result c) where
--   getResultComponentId = getResultComponentId' @(IsComp c)

-- addedChanged :: forall m w. (MonadSystem w m) => (ComponentTicks -> Tick -> Tick -> Bool) -> FilterComponent -> Entity -> m Bool
-- addedChanged !f (FilterComponent (!c, Nothing, Nothing)) e = do
--   !world <- unsafeGetWorld
--   !id <- liftIO $ getComponentId c world.components
--   case id of
--     Nothing -> pure False
--     Just !id -> do
--       !ticks <- liftIO $ tryGetEntityTicks e id world
--       case ticks of
--         Nothing -> pure False
--         Just !ticks -> do
--           (!lastSystemTick, !currentSystemTick) <- liftIO $ getSystemTicksInternal world
--           pure $ f ticks lastSystemTick currentSystemTick
-- addedChanged !f (FilterComponent (!c, Just !entity, Nothing)) !e = do
--   world <- unsafeGetWorld
--   !id <- liftIO $ getComponentId c world.components
--   case id of
--     Nothing -> pure False
--     Just (ComponentId (# !id, _ #)) -> do
--       !ticks <- liftIO $ tryGetEntityTicks e (ComponentId (# id, Just entity #)) world
--       case ticks of
--         Nothing -> pure False
--         Just !ticks -> do
--           (!lastSystemTick, !currentSystemTick) <- liftIO $ getSystemTicksInternal world
--           pure $ f ticks lastSystemTick currentSystemTick
-- addedChanged !f (FilterComponent (!c, _, Just _)) e = do
--   world <- unsafeGetWorld
--   !id <- liftIO $ getComponentId c world.components
--   case id of
--     Nothing -> return False
--     Just (ComponentId (# !id, _ #)) -> do
--       Just (ComponentType (_ :: Proxy a)) <- liftIO $ runQueryEntity (C @ComponentType) world (Entity (# id, 0## #))
--       !rels <- single $ mkGet e (R' @a Any)
--       case rels of
--         Nothing -> pure False
--         Just !rels -> do
--           and
--             <$> for
--               rels
--               ( \(Rel _ !target) -> do
--                   addedChanged f (FilterComponent (c, Just target, Nothing)) e
--               )

-- ticks <- liftIO $ tryGetEntityTicks e (ComponentId (# id, Just entity #)) world
-- case ticks of
--   Nothing -> return False
--   Just ticks -> do
--     (lastSystemTick, currentSystemTick) <- liftIO $ getSystemTicksInternal world
--     return $ f ticks lastSystemTick currentSystemTick

-- added :: forall c m w. (MonadSystem w m, ToFilterComponent c) => c -> Entity -> m Bool
-- added !x = addedChanged qfAddedF (toFilterComponent x)

-- changed :: forall c m w. (MonadSystem w m, ToFilterComponent c) => c -> Entity -> m Bool
-- changed !x = addedChanged qfChangedF (toFilterComponent x)

has :: forall c m w. (MonadSystem w m, ToFilterComponent c) => c -> Entity -> m Bool
has :: forall c (m :: * -> *) w.
(MonadSystem w m, ToFilterComponent c) =>
c -> Entity -> m Bool
has !c
c !Entity
e = do
  !world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  liftIO $ filterEntity (With c) world e

-- | A Query is a chain of operations which return a list of values when ran.
data Query m a where
  BuildQuery :: (Queryable qd out) => qd -> QueryFilter -> Maybe [Entity] -> Query m out
  MapQuery :: Query m b -> (Entity -> b -> m a) -> Query m a
  FilterQuery :: Query m a -> (Entity -> a -> m Bool) -> Query m a
  PairEntityQuery :: Query m a -> Query m (Entity, a)
  DoQuery :: Query m a -> (Entity -> a -> m b) -> Query m a
  CollectQuery :: Query m a -> Query m [From a]
  PureQuery :: a -> Query m a
  AppQuery :: Query m (a -> b) -> Query m a -> Query m b
  BindQuery :: Query m a -> (a -> Query m b) -> Query m b
  EmptyQuery :: Query m a
  RefocusQuery :: Query m a -> Entity -> Query m a
  StopQuery :: Query m a
  IterQuery :: [From a] -> Query m a
  ParQuery :: Query ParSystem a -> Query m a

instance (MonadSystem w m) => Functor (Query m) where
  fmap :: (a -> b) -> Query m a -> Query m b
  fmap :: forall a b. (a -> b) -> Query m a -> Query m b
fmap !a -> b
f !Query m a
a = Query m a -> (Entity -> a -> m b) -> Query m b
forall (m :: * -> *) qd a.
Query m qd -> (Entity -> qd -> m a) -> Query m a
MapQuery Query m a
a (\Entity
_ a
x -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x)

instance (MonadSystem w m) => Applicative (Query m) where
  pure :: a -> Query m a
  pure :: forall a. a -> Query m a
pure = a -> Query m a
forall a (m :: * -> *). a -> Query m a
PureQuery
  (<*>) :: Query m (a -> b) -> Query m a -> Query m b
  <*> :: forall a b. Query m (a -> b) -> Query m a -> Query m b
(<*>) = Query m (a -> b) -> Query m a -> Query m b
forall (m :: * -> *) qd b.
Query m (qd -> b) -> Query m qd -> Query m b
AppQuery

instance (MonadSystem w m) => Monad (Query m) where
  (>>=) :: (MonadSystem w m) => Query m a -> (a -> Query m b) -> Query m b
  >>= :: forall a b.
MonadSystem w m =>
Query m a -> (a -> Query m b) -> Query m b
(>>=) = Query m a -> (a -> Query m b) -> Query m b
forall (m :: * -> *) qd b.
Query m qd -> (qd -> Query m b) -> Query m b
BindQuery

qrun :: (MonadSystem w m) => Query m out -> m [(Entity, out)]
qrun :: forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun (BuildQuery !qd
qd !QueryFilter
qf Maybe [Entity]
Nothing) = do
  !world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  !archetypes' <- findArchetypes qd

  !archetypes <- filterArchetypes archetypes' qf
  !x <- liftIO $ runQueryInternal (E, qd) (Set.toList archetypes) world
  pure $! mapMaybe (\case (Entity
_, Bool
False, (Entity, out)
_) -> Maybe (Entity, out)
forall a. Maybe a
Nothing; (Entity
_, Bool
True, (Entity, out)
x) -> (Entity, out) -> Maybe (Entity, out)
forall a. a -> Maybe a
Just (Entity, out)
x) x
qrun (BuildQuery !qd
qd !QueryFilter
qf (Just [!Entity
entity])) = do
  !world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  !b <- liftIO $ filterEntity qf world entity
  if not b
    then pure []
    else do
      !e <- entityQuery qd entity
      case e of
        Maybe out
Nothing -> [(Entity, out)] -> m [(Entity, out)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just !out
e -> [(Entity, out)] -> m [(Entity, out)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Entity
entity, out
e)]
qrun (BuildQuery !qd
qd !QueryFilter
qf (Just ![Entity]
entities)) = [[(Entity, out)]] -> [(Entity, out)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Entity, out)]] -> [(Entity, out)])
-> m [[(Entity, out)]] -> m [(Entity, out)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Entity -> m [(Entity, out)]) -> [Entity] -> m [[(Entity, out)]]
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 (\Entity
e -> Query m out -> m [(Entity, out)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun (qd -> QueryFilter -> Maybe [Entity] -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter -> Maybe [Entity] -> Query m out
BuildQuery qd
qd QueryFilter
qf ([Entity] -> Maybe [Entity]
forall a. a -> Maybe a
Just [Entity
e]))) [Entity]
entities
qrun (MapQuery !Query m b
a !Entity -> b -> m out
f) = do
  !x <- Query m b -> m [(Entity, b)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m b
a
  mapM (\(!Entity
e, !b
x) -> (Entity
e,) (out -> (Entity, out)) -> m out -> m (Entity, out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity -> b -> m out
f Entity
e b
x) x
qrun (FilterQuery !Query m out
a !Entity -> out -> m Bool
f) = do
  !x <- Query m out -> m [(Entity, out)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m out
a
  filterM (uncurry f) x
qrun (PairEntityQuery !Query m a
a) = do
  !x <- Query m a -> m [(Entity, a)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m a
a
  pure $ map (\(!Entity
e, !a
a) -> (Entity
e, (Entity
e, a
a))) x
qrun (DoQuery !Query m out
a !Entity -> out -> m b
f) = do
  !x <- Query m out -> m [(Entity, out)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m out
a
  for_ x (uncurry f)
  pure x
qrun (CollectQuery !Query m a
a) = do
  !a <- ((Entity, a) -> From a) -> [(Entity, a)] -> [From a]
forall a b. (a -> b) -> [a] -> [b]
map ((Entity -> a -> From a) -> (Entity, a) -> From a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Entity -> a -> From a
forall c. Entity -> c -> From c
From) ([(Entity, a)] -> [From a]) -> m [(Entity, a)] -> m [From a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query m a -> m [(Entity, a)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m a
a
  pure [(Entity (# 0##, 0## #), a)]
qrun (PureQuery !out
a) = [(Entity, out)] -> m [(Entity, out)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [((# Word#, Word# #) -> Entity
Entity (# Word#
0##, Word#
0## #), out
a)]
qrun (AppQuery !Query m (a -> out)
f !Query m a
a) = do
  !f <- Query m (a -> out) -> m [(Entity, a -> out)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m (a -> out)
f
  !a <- qrun a
  pure $ catMaybes $ [tryJoin a f | a <- a, f <- f]
qrun (BindQuery !Query m a
a !a -> Query m out
f) = do
  !x <- Query m a -> m [(Entity, a)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m a
a
  concat
    <$> traverse
      ( \(Entity
_, !a
x) -> do
          Query m out -> m [(Entity, out)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun (a -> Query m out
f a
x)
      )
      x
qrun Query m out
EmptyQuery = [(Entity, out)] -> m [(Entity, out)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
qrun (RefocusQuery !Query m out
a !Entity
e) = do
  !x <- Query m out -> m [(Entity, out)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m out
a
  pure $ map (\(Entity
_, !out
a') -> (Entity
e, out
a')) x
qrun Query m out
StopQuery = [(Entity, out)] -> m [(Entity, out)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
qrun (IterQuery [From out]
a) = [(Entity, out)] -> m [(Entity, out)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Entity, out)] -> m [(Entity, out)])
-> [(Entity, out)] -> m [(Entity, out)]
forall a b. (a -> b) -> a -> b
$ (From out -> (Entity, out)) -> [From out] -> [(Entity, out)]
forall a b. (a -> b) -> [a] -> [b]
map (\(From Entity
e out
a) -> (Entity
e, out
a)) [From out]
a
qrun (ParQuery Query ParSystem out
a) = System [(Entity, out)]
-> ParSystem [(Entity, out)] -> m [(Entity, out)]
forall a. System a -> ParSystem a -> m a
forall (m :: * -> *) a.
SystemAny m =>
System a -> ParSystem a -> m a
systemAny (ParSystem [(Entity, out)] -> System [(Entity, out)]
forall a. ParSystem a -> System a
parLift (ParSystem [(Entity, out)] -> System [(Entity, out)])
-> ParSystem [(Entity, out)] -> System [(Entity, out)]
forall a b. (a -> b) -> a -> b
$ Query ParSystem out -> ParSystem [(Entity, out)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem out
a) (Query ParSystem out -> ParSystem [(Entity, out)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem out
a)

qrunPar :: Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar :: forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar (BuildQuery qd
a QueryFilter
b Maybe [Entity]
c) = Query ParSystem a -> ParSystem [(Entity, a)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun (qd -> QueryFilter -> Maybe [Entity] -> Query ParSystem a
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter -> Maybe [Entity] -> Query m out
BuildQuery qd
a QueryFilter
b Maybe [Entity]
c)
qrunPar (MapQuery !Query ParSystem b
a !Entity -> b -> ParSystem a
f) = do
  !x <- Query ParSystem b -> ParSystem [(Entity, b)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem b
a
  parFor' x (\(!Entity
e, !b
x) -> (Entity
e,) (a -> (Entity, a)) -> ParSystem a -> ParSystem (Entity, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity -> b -> ParSystem a
f Entity
e b
x)
qrunPar (FilterQuery !Query ParSystem a
a !Entity -> a -> ParSystem Bool
f) = do
  !x <- Query ParSystem a -> ParSystem [(Entity, a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem a
a
  catMaybes
    <$> parFor'
      x
      ( \(Entity
e, a
x) -> do
          a <- Entity -> a -> ParSystem Bool
f Entity
e a
x
          pure $ if a then Just (e, x) else Nothing
      )
qrunPar (PairEntityQuery !Query ParSystem a
a) = do
  !x <- Query ParSystem a -> ParSystem [(Entity, a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem a
a
  pure $ map (\(!Entity
e, !a
a) -> (Entity
e, (Entity
e, a
a))) x
qrunPar (DoQuery !Query ParSystem a
a !Entity -> a -> ParSystem b
f) = do
  !x <- Query ParSystem a -> ParSystem [(Entity, a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem a
a
  for_ x (uncurry f)
  pure x
qrunPar (CollectQuery !Query ParSystem a
a) = do
  !a <- ((Entity, a) -> From a) -> [(Entity, a)] -> [From a]
forall a b. (a -> b) -> [a] -> [b]
map ((Entity -> a -> From a) -> (Entity, a) -> From a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Entity -> a -> From a
forall c. Entity -> c -> From c
From) ([(Entity, a)] -> [From a])
-> ParSystem [(Entity, a)] -> ParSystem [From a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query ParSystem a -> ParSystem [(Entity, a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem a
a
  pure [(Entity (# 0##, 0## #), a)]
qrunPar (PureQuery !a
a) = [(Entity, a)] -> ParSystem [(Entity, a)]
forall a. a -> ParSystem a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [((# Word#, Word# #) -> Entity
Entity (# Word#
0##, Word#
0## #), a
a)]
qrunPar (AppQuery !Query ParSystem (a -> a)
f !Query ParSystem a
a) = do
  !f <- Query ParSystem (a -> a) -> ParSystem [(Entity, a -> a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem (a -> a)
f
  !a <- qrunPar a
  pure $ catMaybes $ [tryJoin a f | a <- a, f <- f]
qrunPar (BindQuery !Query ParSystem a
a !a -> Query ParSystem a
f) = do
  !x <- Query ParSystem a -> ParSystem [(Entity, a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem a
a
  concat
    <$> traverse
      ( \(Entity
_, !a
x) -> do
          Query ParSystem a -> ParSystem [(Entity, a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar (a -> Query ParSystem a
f a
x)
      )
      x
qrunPar Query ParSystem a
EmptyQuery = [(Entity, a)] -> ParSystem [(Entity, a)]
forall a. a -> ParSystem a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
qrunPar (RefocusQuery !Query ParSystem a
a !Entity
e) = do
  !x <- Query ParSystem a -> ParSystem [(Entity, a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem a
a
  pure $ map (\(Entity
_, !a
a') -> (Entity
e, a
a')) x
qrunPar Query ParSystem a
StopQuery = [(Entity, a)] -> ParSystem [(Entity, a)]
forall a. a -> ParSystem a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
qrunPar (IterQuery [From a]
a) = [(Entity, a)] -> ParSystem [(Entity, a)]
forall a. a -> ParSystem a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Entity, a)] -> ParSystem [(Entity, a)])
-> [(Entity, a)] -> ParSystem [(Entity, a)]
forall a b. (a -> b) -> a -> b
$ (From a -> (Entity, a)) -> [From a] -> [(Entity, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(From Entity
e a
a) -> (Entity
e, a
a)) [From a]
a
qrunPar (ParQuery Query ParSystem a
a) = Query ParSystem a -> ParSystem [(Entity, a)]
forall a. Query ParSystem a -> ParSystem [(Entity, a)]
qrunPar Query ParSystem a
a

-- qrunPar x = qrun x

tryJoin :: (Entity, a) -> (Entity, a -> b) -> Maybe (Entity, b)
tryJoin :: forall a b. (Entity, a) -> (Entity, a -> b) -> Maybe (Entity, b)
tryJoin (Entity (# Word#
0##, Word#
0## #), !a
a) (!Entity
e, !a -> b
f) = (Entity, b) -> Maybe (Entity, b)
forall a. a -> Maybe a
Just (Entity
e, a -> b
f a
a)
tryJoin (!Entity
e, !a
a) (Entity (# Word#
0##, Word#
0## #), !a -> b
f) = (Entity, b) -> Maybe (Entity, b)
forall a. a -> Maybe a
Just (Entity
e, a -> b
f a
a)
tryJoin (!Entity
e, !a
a) (!Entity
e', !a -> b
f)
  | Entity
e Entity -> Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity
e' = (Entity, b) -> Maybe (Entity, b)
forall a. a -> Maybe a
Just (Entity
e, a -> b
f a
a)
  | Bool
otherwise = Maybe (Entity, b)
forall a. Maybe a
Nothing

-- | Run a 'Query', returning a list of values.
query :: (MonadSystem w m) => Query m out -> m [out]
query :: forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [out]
query !Query m out
a = ((Entity, out) -> out) -> [(Entity, out)] -> [out]
forall a b. (a -> b) -> [a] -> [b]
map (Entity, out) -> out
forall a b. (a, b) -> b
snd ([(Entity, out)] -> [out]) -> m [(Entity, out)] -> m [out]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query m out -> m [(Entity, out)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m out
a

-- | Run a 'Query'.
query_ :: (MonadSystem w m) => Query m out -> m ()
query_ :: forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ !Query m out
a = m [(Entity, out)] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [(Entity, out)] -> m ()) -> m [(Entity, out)] -> m ()
forall a b. (a -> b) -> a -> b
$ Query m out -> m [(Entity, out)]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [(Entity, out)]
qrun Query m out
a

-- | Run a 'Query', returning an element only if it was the only result.
single :: (MonadSystem w m) => Query m out -> m (Maybe out)
single :: forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single !Query m out
a = do
  !x <- Query m out -> m [out]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [out]
query Query m out
a
  case x of
    [!out
x] -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (out -> Maybe out
forall a. a -> Maybe a
Just (out -> Maybe out) -> out -> Maybe out
forall a b. (a -> b) -> a -> b
$! out
x)
    [out]
_ -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe out
forall a. Maybe a
Nothing

-- | Run a 'Query', returning an arbitrary element produced by it, or nothing if the query was null.
queryOne :: (MonadSystem w m) => Query m out -> m (Maybe out)
queryOne :: forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
queryOne !Query m out
a = do
  x <- Query m out -> m [out]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [out]
query Query m out
a
  case x of
    (!out
x : [out]
_) -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (out -> Maybe out
forall a. a -> Maybe a
Just (out -> Maybe out) -> out -> Maybe out
forall a b. (a -> b) -> a -> b
$! out
x)
    [out]
_ -> Maybe out -> m (Maybe out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe out
forall a. Maybe a
Nothing

mkQuery :: (Queryable qd out) => qd -> Query m out
mkQuery :: forall qd out (m :: * -> *). Queryable qd out => qd -> Query m out
mkQuery !qd
x = qd -> QueryFilter -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter -> Query m out
mkQuery' qd
x QueryFilter
NoFilter

mkQuery' :: (Queryable qd out) => qd -> QueryFilter -> Query m out
mkQuery' :: forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter -> Query m out
mkQuery' !qd
a !QueryFilter
b = qd -> QueryFilter -> Maybe [Entity] -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter -> Maybe [Entity] -> Query m out
BuildQuery qd
a QueryFilter
b Maybe [Entity]
forall a. Maybe a
Nothing

mkGet :: (Queryable qd out) => Entity -> qd -> Query m out
mkGet :: forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> Query m out
mkGet !Entity
x !qd
a = Entity -> qd -> QueryFilter -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> QueryFilter -> Query m out
mkGet' Entity
x qd
a QueryFilter
NoFilter

mkGet' :: (Queryable qd out) => Entity -> qd -> QueryFilter -> Query m out
mkGet' :: forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> QueryFilter -> Query m out
mkGet' !Entity
a !qd
b !QueryFilter
c = qd -> QueryFilter -> Maybe [Entity] -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter -> Maybe [Entity] -> Query m out
BuildQuery qd
b QueryFilter
c ([Entity] -> Maybe [Entity]
forall a. a -> Maybe a
Just [Entity
a])

check :: forall m w. (MonadSystem w m) => QueryFilter -> Entity -> m Bool
check :: forall (m :: * -> *) w.
MonadSystem w m =>
QueryFilter -> Entity -> m Bool
check QueryFilter
f Entity
e = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> m (Maybe ()) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query m () -> m (Maybe ())
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single (Entity -> () -> QueryFilter -> Query m ()
forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> QueryFilter -> Query m out
mkGet' Entity
e () QueryFilter
f)

-- | Same as 'runWhen', but runs when the provided query is not empty.
runWhenQ :: (Typeable a) => Query System a -> ([a] -> System b) -> System ()
runWhenQ :: forall a b.
Typeable a =>
Query System a -> ([a] -> System b) -> System ()
runWhenQ Query System a
q =
  System (Maybe [a]) -> ([a] -> System b) -> System ()
forall a b.
Typeable a =>
System (Maybe a) -> (a -> System b) -> System ()
runWhen
    ( do
        x <- Query System a -> System [a]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [out]
query Query System a
q
        pure $ case x of
          [] -> Maybe [a]
forall a. Maybe a
Nothing
          [a]
a -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
a
    )

-- | Same as 'runWhen', but runs when the provided query is not empty. Picks an arbitrary element to pass forward.
runWhenOne :: (Typeable a) => Query System a -> (a -> System b) -> System ()
runWhenOne :: forall a b.
Typeable a =>
Query System a -> (a -> System b) -> System ()
runWhenOne Query System a
q =
  System (Maybe a) -> (a -> System b) -> System ()
forall a b.
Typeable a =>
System (Maybe a) -> (a -> System b) -> System ()
runWhen
    ( do
        x <- Query System a -> System [a]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [out]
query Query System a
q
        pure $ case x of
          [] -> Maybe a
forall a. Maybe a
Nothing
          (a
a : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    )

filterToQuery :: (ToFilterComponent a) => World -> a -> IO (Maybe (ComponentId, ComponentQuery))
filterToQuery :: forall a.
ToFilterComponent a =>
World -> a -> IO (Maybe (ComponentId, ComponentQuery))
filterToQuery World
world a
a = do
  let FilterComponent (TypeRep, Maybe Entity, Maybe Any)
x = a -> FilterComponent
forall a. ToFilterComponent a => a -> FilterComponent
toFilterComponent a
a
  case (TypeRep, Maybe Entity, Maybe Any)
x of
    (TypeRep
c, Maybe Entity
Nothing, Maybe Any
Nothing) -> do
      x <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
c World
world.components
      pure $ fmap (,ComponentQuery) x
    (TypeRep
c, Just Entity
e, Maybe Any
Nothing) -> do
      x <- (ComponentId -> ComponentId)
-> Maybe ComponentId -> Maybe ComponentId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Entity -> ComponentId -> ComponentId
setCompIdTarget (Maybe Entity -> ComponentId -> ComponentId)
-> Maybe Entity -> ComponentId -> ComponentId
forall a b. (a -> b) -> a -> b
$ Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e) (Maybe ComponentId -> Maybe ComponentId)
-> IO (Maybe ComponentId) -> IO (Maybe ComponentId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
c World
world.components
      pure $ fmap (,RelationshipQuery) x
    (TypeRep
c, Maybe Entity
_, Just Any
_) -> do
      x <- TypeRep -> Components -> IO (Maybe ComponentId)
getComponentId TypeRep
c World
world.components
      pure $ fmap (,RelationshipQueryAny) x

filterArchetypes :: (MonadSystem w m) => Set ArchetypeId -> QueryFilter -> m (Set ArchetypeId)
filterArchetypes :: forall w (m :: * -> *).
MonadSystem w m =>
Set ArchetypeId -> QueryFilter -> m (Set ArchetypeId)
filterArchetypes Set ArchetypeId
prev QueryFilter
NoFilter = Set ArchetypeId -> m (Set ArchetypeId)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set ArchetypeId
prev
filterArchetypes Set ArchetypeId
prev (With a
x) = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  f <- liftIO $ filterToQuery world x
  case f of
    Maybe (ComponentId, ComponentQuery)
Nothing -> Set ArchetypeId -> m (Set ArchetypeId)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set ArchetypeId
forall a. Set a
Set.empty
    Just (ComponentId, ComponentQuery)
f -> do
      a <- (ComponentId, ComponentQuery) -> m (Set ArchetypeId)
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentId, ComponentQuery) -> m (Set ArchetypeId)
archetypesWith (ComponentId, ComponentQuery)
f
      pure $ Set.intersection prev a
filterArchetypes Set ArchetypeId
prev (Without a
x) = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  f <- liftIO $ filterToQuery world x
  case f of
    Maybe (ComponentId, ComponentQuery)
Nothing -> Set ArchetypeId -> m (Set ArchetypeId)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set ArchetypeId
prev
    Just (ComponentId, ComponentQuery)
f -> do
      a <- (ComponentId, ComponentQuery) -> m (Set ArchetypeId)
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentId, ComponentQuery) -> m (Set ArchetypeId)
archetypesWithout (ComponentId, ComponentQuery)
f
      pure $ Set.intersection prev a
filterArchetypes Set ArchetypeId
prev (Changed a
x Tick -> Tick -> Bool
f1 Tick -> Tick -> Bool
f2) = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  -- TODO: use Set.filterA from containers>=0.8.1
  Set.fromList
    <$> filterM
      ( \ArchetypeId
a -> do
          let Tables IOVec Table
tables = World
world.tables
          table <- Vec (PrimState m) Table -> Int -> m Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState m) Table
tables ArchetypeId
a.id
          liftIO $ filterArchetype (Changed x f1 f2) world table
      )
      (Set.toList prev)
filterArchetypes Set ArchetypeId
prev (And QueryFilter
x QueryFilter
y) = do
  prev' <- Set ArchetypeId -> QueryFilter -> m (Set ArchetypeId)
forall w (m :: * -> *).
MonadSystem w m =>
Set ArchetypeId -> QueryFilter -> m (Set ArchetypeId)
filterArchetypes Set ArchetypeId
prev QueryFilter
x
  filterArchetypes prev' y
filterArchetypes Set ArchetypeId
prev (Or QueryFilter
x QueryFilter
y) = do
  a <- Set ArchetypeId -> QueryFilter -> m (Set ArchetypeId)
forall w (m :: * -> *).
MonadSystem w m =>
Set ArchetypeId -> QueryFilter -> m (Set ArchetypeId)
filterArchetypes Set ArchetypeId
prev QueryFilter
x
  b <- filterArchetypes prev y
  pure $ Set.union a b