{-# 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 qualified as Set
import Data.Traversable
import Mischief.ECS.Archetypes.Graph
import Mischief.ECS.Components
import Mischief.ECS.Entities
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)

findArchetypes :: forall qd m w output. (Queryable qd output, MonadSystem w m) => qd -> m [([ComponentId], ArchetypeId)]
findArchetypes :: forall qd (m :: * -> *) w output.
(Queryable qd output, MonadSystem w m) =>
qd -> m [([ComponentId], 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
            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.toList (queryTypes query))

  findMatchingArchetypes (catMaybes components) world.archetypes

-- 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
  return $ 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 :: forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentTicks -> Tick -> Tick -> Bool)
-> FilterComponent -> Entity -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
f (FilterComponent (TypeRep
c, Maybe Entity
Nothing, Maybe Any
Nothing)) Entity
e = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  id <- liftIO $ getComponentId c world.components
  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
      ticks <- IO (Maybe ComponentTicks) -> m (Maybe ComponentTicks)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ComponentTicks) -> m (Maybe ComponentTicks))
-> IO (Maybe ComponentTicks) -> m (Maybe ComponentTicks)
forall a b. (a -> b) -> a -> b
$ Entity -> ComponentId -> World -> IO (Maybe ComponentTicks)
tryGetEntityTicks Entity
e ComponentId
id World
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
addedChanged ComponentTicks -> Tick -> Tick -> Bool
f (FilterComponent (TypeRep
c, Just Entity
entity, Maybe Any
Nothing)) Entity
e = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  id <- liftIO $ getComponentId c world.components
  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 (# Word#
id, Maybe Entity
_ #)) -> do
      ticks <- IO (Maybe ComponentTicks) -> m (Maybe ComponentTicks)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ComponentTicks) -> m (Maybe ComponentTicks))
-> IO (Maybe ComponentTicks) -> m (Maybe ComponentTicks)
forall a b. (a -> b) -> a -> b
$ Entity -> ComponentId -> World -> IO (Maybe ComponentTicks)
tryGetEntityTicks Entity
e ((# Word#, Maybe Entity #) -> ComponentId
ComponentId (# Word#
id, Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
entity #)) World
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
addedChanged ComponentTicks -> Tick -> Tick -> Bool
f (FilterComponent (TypeRep
c, Maybe Entity
_, Just Any
_)) Entity
e = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  id <- liftIO $ getComponentId c world.components
  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 (# Word#
id, Maybe Entity
_ #)) -> do
      Just (ComponentType (_ :: Proxy a)) <- IO (Maybe ComponentType) -> m (Maybe ComponentType)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ComponentType) -> m (Maybe ComponentType))
-> IO (Maybe ComponentType) -> m (Maybe ComponentType)
forall a b. (a -> b) -> a -> b
$ C ComponentType -> World -> Entity -> IO (Maybe ComponentType)
forall qd output.
Queryable qd output =>
qd -> World -> Entity -> IO (Maybe output)
runQueryEntity (forall a. C a
forall {k} (a :: k). C a
C @ComponentType) World
world ((# Word#, Word# #) -> Entity
Entity (# Word#
id, Word#
0## #))
      rels <- single $ mkGet e (R' @a Any)
      case rels of
        Maybe [Rel c]
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Just [Rel c]
rels -> do
          [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rel c] -> (Rel c -> m Bool) -> m [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
              [Rel c]
rels
              ( \(Rel c
_ Entity
target) -> do
                  (ComponentTicks -> Tick -> Tick -> Bool)
-> FilterComponent -> Entity -> m Bool
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentTicks -> Tick -> Tick -> Bool)
-> FilterComponent -> Entity -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
f ((TypeRep, Maybe Entity, Maybe Any) -> FilterComponent
FilterComponent (TypeRep
c, Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
target, Maybe Any
forall a. Maybe a
Nothing)) Entity
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 :: forall c (m :: * -> *) w.
(MonadSystem w m, ToFilterComponent c) =>
c -> Entity -> m Bool
added c
x = (ComponentTicks -> Tick -> Tick -> Bool)
-> FilterComponent -> Entity -> m Bool
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentTicks -> Tick -> Tick -> Bool)
-> FilterComponent -> Entity -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
qfAddedF (c -> FilterComponent
forall a. ToFilterComponent a => a -> FilterComponent
toFilterComponent c
x)

changed :: forall c m w. (MonadSystem w m, ToFilterComponent c) => c -> Entity -> m Bool
changed :: forall c (m :: * -> *) w.
(MonadSystem w m, ToFilterComponent c) =>
c -> Entity -> m Bool
changed c
x = (ComponentTicks -> Tick -> Tick -> Bool)
-> FilterComponent -> Entity -> m Bool
forall (m :: * -> *) w.
MonadSystem w m =>
(ComponentTicks -> Tick -> Tick -> Bool)
-> FilterComponent -> Entity -> m Bool
addedChanged ComponentTicks -> Tick -> Tick -> Bool
qfChangedF (c -> FilterComponent
forall a. ToFilterComponent a => a -> FilterComponent
toFilterComponent c
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

-- newtype Query a = Query [(Entity, a)]

data Query m a where
  BuildQuery :: (Queryable qd out) => qd -> QueryFilter ArchetypeFilter -> 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
  FoldQuery :: Query m a -> Entity -> (From a -> b -> b) -> b -> Query m b
  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

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

-- grun :: (MonadSystem w m) => Entity -> Query m out -> m (Maybe (Entity, out))
-- grun entity (BuildQuery qd qf e) = do
--   world <- unsafeGetWorld
--   b <- liftIO $ filterEntity qf world entity
--   if b then fmap (entity,) <$> entityQuery qd entity else pure Nothing
-- grun entity (MapQuery a f) = do
--   x <- grun entity a
--   case x of
--     Nothing -> pure Nothing
--     Just (e, x) -> fmap (e,) . Just <$> f entity x
-- grun entity (FilterQuery a f) = do
--   x <- grun entity a
--   case x of
--     Nothing -> pure Nothing
--     Just (e, x) -> do
--       b <- f entity x
--       if b then pure $ Just (e, x) else pure Nothing
-- grun entity (DoQuery a f) = do
--   x <- grun entity a
--   for_ x $ uncurry f
--   pure x
-- grun _ (FoldQuery a e f i) = do
--   x <- map snd <$> qrun a
--   let x' = foldr f i x
--   pure $ Just (e, x')
-- grun _ (PureQuery a) = pure $ Just (Entity (# 0##, 0## #), a)
-- grun entity (AppQuery f a) = do
--   f <- grun entity f
--   a <- grun entity a
--   case (,) <$> f <*> a of
--     Nothing -> pure Nothing
--     Just ((_, f), (e', a)) -> pure $ Just (e', f a)
-- grun entity (BindQuery f a) = do
--   x <- grun entity f
--   case x of
--     Nothing -> pure Nothing
--     Just (_, x) -> grun entity (a x)

-- get :: (MonadSystem w m) => Entity -> Query m out -> m (Maybe out)
-- get e a = fmap snd <$> grun e a

-- get_ :: (MonadSystem w m) => Entity -> Query m out -> m ()
-- get_ a b = void $ get a b

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 'ArchetypeFilter
qf Maybe [Entity]
Nothing) = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  archetypes' <- findArchetypes qd
  archetypes <- liftIO (filterM (filterArchetype qf world . fst) archetypes')
  x <- liftIO $ runQueryInternal (E, qd) (map snd 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 'ArchetypeFilter
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 'ArchetypeFilter
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 'ArchetypeFilter -> Maybe [Entity] -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter 'ArchetypeFilter -> Maybe [Entity] -> Query m out
BuildQuery qd
qd QueryFilter 'ArchetypeFilter
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 (FoldQuery Query m a
a Entity
e From a -> out -> out
f out
i) = 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 [(e, foldr f i 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
  -- concatMap (\(a, b) -> map (a,) b) <$> traverse (\(e, x) -> do (e,) <$> query (f x)) x
  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

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

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

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

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 (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 (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 'ArchetypeFilter -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter 'ArchetypeFilter -> Query m out
mkQuery' qd
x QueryFilter 'ArchetypeFilter
forall (f :: FilterType). QueryFilter f
NoFilter

mkQuery' :: (Queryable qd out) => qd -> QueryFilter ArchetypeFilter -> Query m out
mkQuery' :: forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter 'ArchetypeFilter -> Query m out
mkQuery' qd
a QueryFilter 'ArchetypeFilter
b = qd -> QueryFilter 'ArchetypeFilter -> Maybe [Entity] -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter 'ArchetypeFilter -> Maybe [Entity] -> Query m out
BuildQuery qd
a QueryFilter 'ArchetypeFilter
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 'ArchetypeFilter -> Query m out
forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> QueryFilter 'ArchetypeFilter -> Query m out
mkGet' Entity
x qd
a QueryFilter 'ArchetypeFilter
forall (f :: FilterType). QueryFilter f
NoFilter

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