{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module Mischief.ECS.World.Query.Pipe
  ( -- * Impure
    qtraverse,
    qtap,

    -- * Chaining
    qthen,

    -- * Folds
    qfoldr,
    qcollect,

    -- * Mapping
    qmap,
    qmapM,
    qmapMaybe,
    qmapMaybeM,

    -- * Filtering
    qcheck,
    qfilter,
    qfilterM,

    -- * Insertion
    qinsert,
    qinsertNew,
    qinsertIfNeq,
    qmodify,
    qmodifyNew,
    qmodifyIfNeq,

    -- * Expansion
    qextend,
    -- qres,
    qentity,

    -- * Traversal
    qget,
    qgetAll,
    qrelateOne,
    qrelateMany,
    -- qgetM,
    -- qgetMany,
    -- qgetManyM,
    -- qrelate,
    -- qrelateMany,
    -- qcross,
    -- qcrossM,

    -- * Joins
    qjoin,
    -- qjoin,
    -- qjoinOuter,

    qrefocus,
    qres,
    qpure,

    -- * Logging
    qinfo,
    qwarn,
    qerr,
  )
where

import Control.Monad (filterM, void)
import Control.Monad.IO.Class
import Data.Foldable
import Data.Function
import Data.List (List)
import Data.Maybe
import Data.Text (Text)
import Data.Traversable
import GHC.Stack
import Language.Haskell.TH (Extension (AllowAmbiguousTypes))
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Common
import Mischief.ECS.Entities
import Mischief.ECS.Log
import Mischief.ECS.World
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers
import Mischief.ECS.World.Query.QueryFilter
import Mischief.ECS.World.Query.Queryable
import Mischief.ECS.World.Query.TH (q)
import Mischief.ECS.World.Spawn

{-# RULES
"qmap/qmap" forall f g xs. qmap f (qmap g xs) = qmap (f . g) xs
  #-}

qthen :: (MonadSystem w m) => (a -> Query m b) -> Query m a -> Query m b
qthen :: forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> Query m b) -> Query m a -> Query m b
qthen = (Query m a -> (a -> Query m b) -> Query m b)
-> (a -> Query m b) -> Query m a -> Query m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Query m a -> (a -> Query m b) -> Query m b
forall (m :: * -> *) a1 a.
Query m a1 -> (a1 -> Query m a) -> Query m a
BindQuery

qfoldr :: (MonadSystem w m) => (From a -> b -> b) -> b -> Entity -> Query m a -> Query m b
qfoldr :: forall w (m :: * -> *) a b.
MonadSystem w m =>
(From a -> b -> b) -> b -> Entity -> Query m a -> Query m b
qfoldr From a -> b -> b
f b
b Entity
e Query m a
a = Query m a -> Entity -> (From a -> b -> b) -> b -> Query m b
forall (m :: * -> *) a1 a.
Query m a1 -> Entity -> (From a1 -> a -> a) -> a -> Query m a
FoldQuery Query m a
a Entity
e From a -> b -> b
f b
b

qcollect :: (MonadSystem w m) => Entity -> Query m a -> Query m [From a]
qcollect :: forall w (m :: * -> *) a.
MonadSystem w m =>
Entity -> Query m a -> Query m [From a]
qcollect = (From a -> [From a] -> [From a])
-> [From a] -> Entity -> Query m a -> Query m [From a]
forall w (m :: * -> *) a b.
MonadSystem w m =>
(From a -> b -> b) -> b -> Entity -> Query m a -> Query m b
qfoldr (:) []

-- | Maps @Query m a@ to @Query m b@. Same as 'fmap'.
--
-- __Example__
--
-- @
-- [q|Name, Position|]
--   & qmap (\\(name, _) -> name)
--   & query
-- @
qmap :: (MonadSystem w m) => (a -> b) -> Query m a -> Query m b
qmap :: forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> b) -> Query m a -> Query m b
qmap = (a -> b) -> Query m a -> Query m b
forall a b. (a -> b) -> Query m a -> Query m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
{-# INLINE [1] qmap #-}

-- | Same as 'qtraverse'.
qmapM :: (MonadSystem w m) => (Entity -> a -> m b) -> Query m a -> Query m b
qmapM :: forall w (m :: * -> *) a b.
MonadSystem w m =>
(Entity -> a -> m b) -> Query m a -> Query m b
qmapM = (Entity -> a -> m b) -> Query m a -> Query m b
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m b
qtraverse

qmapMaybeM :: (MonadSystem w m) => (Entity -> a -> m (Maybe b)) -> Query m a -> Query m b
qmapMaybeM :: forall w (m :: * -> *) a b.
MonadSystem w m =>
(Entity -> a -> m (Maybe b)) -> Query m a -> Query m b
qmapMaybeM Entity -> a -> m (Maybe b)
f Query m a
b = Query m (Maybe b) -> (Entity -> Maybe b -> m b) -> Query m b
forall (m :: * -> *) b a.
Query m b -> (Entity -> b -> m a) -> Query m a
MapQuery (Query m (Maybe b)
-> (Entity -> Maybe b -> m Bool) -> Query m (Maybe b)
forall (m :: * -> *) a.
Query m a -> (Entity -> a -> m Bool) -> Query m a
FilterQuery (Query m a -> (Entity -> a -> m (Maybe b)) -> Query m (Maybe b)
forall (m :: * -> *) b a.
Query m b -> (Entity -> b -> m a) -> Query m a
MapQuery Query m a
b Entity -> a -> m (Maybe b)
f) (\Entity
_ Maybe b
x -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> Bool
forall a. Maybe a -> Bool
isJust Maybe b
x))) (\Entity
_ Maybe b
x -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
forall a. HasCallStack => a
undefined Maybe b
x))

-- | Possibly maps each element from @Query m a@ to an element from @Query m b@. If Nothing, will filter this Entity out of the Query.
--
-- __Example__
--
-- @
-- f :: Name -> Maybe Name
-- @
--
-- @
-- [q|Name|]
--   & qmapMaybe f
--   & query
-- @
qmapMaybe :: (MonadSystem w m) => (a -> Maybe b) -> Query m a -> Query m b
qmapMaybe :: forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> Maybe b) -> Query m a -> Query m b
qmapMaybe a -> Maybe b
f Query m a
x = (Maybe b -> b) -> Query m (Maybe b) -> Query m b
forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> b) -> Query m a -> Query m b
qmap (b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
forall a. HasCallStack => a
undefined) (Query m (Maybe b) -> Query m b) -> Query m (Maybe b) -> Query m b
forall a b. (a -> b) -> a -> b
$ (Maybe b -> Bool) -> Query m (Maybe b) -> Query m (Maybe b)
forall w (m :: * -> *) a.
MonadSystem w m =>
(a -> Bool) -> Query m a -> Query m a
qfilter Maybe b -> Bool
forall a. Maybe a -> Bool
isJust ((a -> Maybe b) -> Query m a -> Query m (Maybe b)
forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> b) -> Query m a -> Query m b
qmap a -> Maybe b
f Query m a
x)

-- mapFilterQuery
--   x
--   ( \_ a ->
--       pure $ f a
--   )

-- | Map @Query m a@ to @Query m b@ with side effects.
--
-- __Example__
--
-- @
-- [q|Name, Position|]
--   & qtraverse (\\e (name, pos) -> do
--     [i|The name of entity #{e} is #{name}|]
--     pure pos
--   )
--   & query
-- @
qtraverse :: (Entity -> a -> m b) -> Query m a -> Query m b
qtraverse :: forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m b
qtraverse Entity -> a -> m b
f Query m a
x = Query m a -> (Entity -> a -> m b) -> Query m b
forall (m :: * -> *) b a.
Query m b -> (Entity -> b -> m a) -> Query m a
MapQuery Query m a
x Entity -> a -> m b
f

-- | Apply a side effect over a query.
--
-- __Example__
--
-- @
-- [q|Name, Position|]
--   & qtraverse (\\e (name, pos) -> do
--     [i|The name of entity #{e} is #{name}|]
--   )
--   & query
-- @
qtap :: (Entity -> a -> m b) -> Query m a -> Query m a
qtap :: forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m a
qtap = (Query m a -> (Entity -> a -> m b) -> Query m a)
-> (Entity -> a -> m b) -> Query m a -> Query m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Query m a -> (Entity -> a -> m b) -> Query m a
forall (m :: * -> *) a b.
Query m a -> (Entity -> a -> m b) -> Query m a
DoQuery

-- | Insert the values obtained from a mapping function.
--
-- __Example__
--
-- @
-- q[|Position, Velocity|]
--   & qinsert (\\(Position p, Velocity v) -> Position (p + v))
--   & query
-- @
qinsert :: (Bundle b) => (a -> b) -> Query System a -> Query System a
qinsert :: forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System a
qinsert a -> b
f = (Entity -> a -> System ()) -> Query System a -> Query System a
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m a
qtap (\Entity
e a
a -> b -> Entity -> System ()
forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert (a -> b
f a
a) Entity
e)

-- | Same as 'qinsert' but only inserts components that aren't already on the entity.
qinsertNew :: (Bundle b) => (a -> b) -> Query System a -> Query System a
qinsertNew :: forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System a
qinsertNew a -> b
f = (Entity -> a -> System ()) -> Query System a -> Query System a
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m a
qtap (\Entity
e a
a -> b -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insertNew (a -> b
f a
a) Entity
e)

-- | Same as 'qinsert' but only inserts components that are new or different than the ones already on the entity. Avoids triggering false change detection.
qinsertIfNeq :: (BundleEq b) => (a -> b) -> Query System a -> Query System a
qinsertIfNeq :: forall b a.
BundleEq b =>
(a -> b) -> Query System a -> Query System a
qinsertIfNeq a -> b
f = (Entity -> a -> System ()) -> Query System a -> Query System a
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m a
qtap (\Entity
e a
a -> b -> Entity -> System ()
forall b. BundleEq b => b -> Entity -> System ()
insertIfNeq (a -> b
f a
a) Entity
e)

-- | Same as 'qinsert' but will also propagate the mapped elements. Equivalent to @qinsert id . qmap f@.
qmodify :: (Bundle b) => (a -> b) -> Query System a -> Query System b
qmodify :: forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System b
qmodify a -> b
f = (b -> b) -> Query System b -> Query System b
forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System a
qinsert b -> b
forall a. a -> a
id (Query System b -> Query System b)
-> (Query System a -> Query System b)
-> Query System a
-> Query System b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Query System a -> Query System b
forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> b) -> Query m a -> Query m b
qmap a -> b
f

-- | Same as 'qinsertNew' but will also propagate the mapped elements. Equivalent to @qinsertNew id . qmap f@.
qmodifyNew :: (Bundle b) => (a -> b) -> Query System a -> Query System b
qmodifyNew :: forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System b
qmodifyNew a -> b
f = (b -> b) -> Query System b -> Query System b
forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System a
qinsertNew b -> b
forall a. a -> a
id (Query System b -> Query System b)
-> (Query System a -> Query System b)
-> Query System a
-> Query System b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Query System a -> Query System b
forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> b) -> Query m a -> Query m b
qmap a -> b
f

-- | Same as 'qinsertIfNeq' but will also propagate the mapped elements. Equivalent to @qinsertIfNeq id . qmap f@.
qmodifyIfNeq :: (BundleEq b) => (a -> b) -> Query System a -> Query System b
qmodifyIfNeq :: forall b a.
BundleEq b =>
(a -> b) -> Query System a -> Query System b
qmodifyIfNeq a -> b
f = (b -> b) -> Query System b -> Query System b
forall b a.
BundleEq b =>
(a -> b) -> Query System a -> Query System a
qinsertIfNeq b -> b
forall a. a -> a
id (Query System b -> Query System b)
-> (Query System a -> Query System b)
-> Query System a
-> Query System b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Query System a -> Query System b
forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> b) -> Query m a -> Query m b
qmap a -> b
f

{-# RULES
"qfilter/qfilter" forall f g xs. qfilter f (qfilter g xs) = qfilter (\x -> f x && g x) xs
  #-}

-- | Filter the entities of a query.
--
-- __Example__
--
-- @
-- [q|Name|]
--   & qfilter (== Name "Florian")
--   & query
-- @
qfilter :: (MonadSystem w m) => (a -> Bool) -> Query m a -> Query m a
qfilter :: forall w (m :: * -> *) a.
MonadSystem w m =>
(a -> Bool) -> Query m a -> Query m a
qfilter a -> Bool
f Query m a
x = Query m a -> (Entity -> a -> m Bool) -> Query m a
forall (m :: * -> *) a.
Query m a -> (Entity -> a -> m Bool) -> Query m a
FilterQuery Query m a
x (\Entity
_ a
x -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Bool
f a
x))
{-# INLINE [1] qfilter #-}

-- | Filter the entities of a query with possible side effects.
--
-- __Example__
--
-- @
-- [q|Position|]
--   & qfilterM (\\e _ -> 'changed' \@Position e)
--   & query
-- @
qfilterM :: (Entity -> a -> m Bool) -> Query m a -> Query m a
qfilterM :: forall a (m :: * -> *).
(Entity -> a -> m Bool) -> Query m a -> Query m a
qfilterM Entity -> a -> m Bool
f Query m a
x = Query m a -> (Entity -> a -> m Bool) -> Query m a
forall (m :: * -> *) a.
Query m a -> (Entity -> a -> m Bool) -> Query m a
FilterQuery Query m a
x Entity -> a -> m Bool
f

check :: (MonadSystem w m) => QueryFilter EntityFilter -> Entity -> m Bool
check :: forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter 'EntityFilter -> Entity -> m Bool
check QueryFilter 'EntityFilter
NoFilter Entity
_ = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
check (With a
x) Entity
e = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  liftIO $ filterEntity (With x) world e
check (Without a
x) Entity
e = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  liftIO $ filterEntity (Without x) world e
check (Added a
x) Entity
e = a -> Entity -> m Bool
forall c (m :: * -> *) w.
(MonadSystem w m, ToFilterComponent c) =>
c -> Entity -> m Bool
added a
x Entity
e
check (Changed a
x) Entity
e = a -> Entity -> m Bool
forall c (m :: * -> *) w.
(MonadSystem w m, ToFilterComponent c) =>
c -> Entity -> m Bool
changed a
x Entity
e
check (And QueryFilter 'EntityFilter
a QueryFilter 'EntityFilter
b) Entity
e = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> m Bool -> m (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryFilter 'EntityFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter 'EntityFilter -> Entity -> m Bool
check QueryFilter 'EntityFilter
a Entity
e m (Bool -> Bool) -> m Bool -> m Bool
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QueryFilter 'EntityFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter 'EntityFilter -> Entity -> m Bool
check QueryFilter 'EntityFilter
b Entity
e
check (Or QueryFilter 'EntityFilter
a QueryFilter 'EntityFilter
b) Entity
e = Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> m Bool -> m (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryFilter 'EntityFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter 'EntityFilter -> Entity -> m Bool
check QueryFilter 'EntityFilter
a Entity
e m (Bool -> Bool) -> m Bool -> m Bool
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QueryFilter 'EntityFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter 'EntityFilter -> Entity -> m Bool
check QueryFilter 'EntityFilter
b Entity
e
check (Not QueryFilter 'EntityFilter
a) Entity
e = Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryFilter 'EntityFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter 'EntityFilter -> Entity -> m Bool
check QueryFilter 'EntityFilter
a Entity
e

{-# RULES
"qcheck/qcheck" forall f g xs. qcheck f (qcheck g xs) = qcheck (f `And` g) xs
  #-}

-- | Filter the entities of a query with a dedicated query filter.
--
-- __Example__
--
-- @
-- [q|Position|]
--   & qcheck [f|Changed Position, !Added Position|]
--   & query
-- @
qcheck :: (MonadSystem w m) => QueryFilter EntityFilter -> Query m a -> Query m a
qcheck :: forall w (m :: * -> *) a.
MonadSystem w m =>
QueryFilter 'EntityFilter -> Query m a -> Query m a
qcheck QueryFilter 'EntityFilter
f = (Entity -> a -> m Bool) -> Query m a -> Query m a
forall a (m :: * -> *).
(Entity -> a -> m Bool) -> Query m a -> Query m a
qfilterM (\Entity
e a
_ -> QueryFilter 'EntityFilter -> Entity -> m Bool
forall w (m :: * -> *).
MonadSystem w m =>
QueryFilter 'EntityFilter -> Entity -> m Bool
check QueryFilter 'EntityFilter
f Entity
e)
{-# INLINE [1] qcheck #-}

-- | Grab a specific entity from another query and map it into the current one. If the first function returns Nothing, will filter this entity
-- out of the query.
--
--  __Example__
--
-- @
-- data Sprite = Sprite {image :: Entity} deriving (Component)
-- @
--
-- @
-- [q|Sprite|]
--   qget (\\sprite -> sprite.image) (,) [q|Image|]
--   & query
-- @
-- qget :: (MonadSystem w m) => (a -> Maybe Entity) -> Query m b -> Query m a -> Join m a Maybe (From b)
-- qget f b a =
--   Join
--     a
--     ( \_ x -> do
--         let entity = f x
--         case entity of
--           Nothing -> pure Nothing
--           Just entity -> do
--             bs <- get entity b
--             pure $ fmap (From entity) bs
--     )

-- Like 'qget' but with side-effects in the function which provides the entity.
-- qgetM :: (MonadSystem w m) => (Entity -> a -> m (Maybe Entity)) -> Query m b -> Query m a -> Join m a Maybe (From b)
-- qgetM f b a =
--   Join
--     a
--     ( \e x -> do
--         entity <- f e x
--         case entity of
--           Nothing -> pure Nothing
--           Just entity -> do
--             bs <- single (mkGet entity b)
--             pure $ fmap (From entity) bs
--     )

-- | Grab specific entities from another query. If the first function returns an empty list, will filter this entity out of the query.
--
-- __Example__
--
-- @
-- data Images = Images {images :: [Entity]} deriving (Component)
-- @
--
-- @
-- [q|Images|]
--   & qgetMany (.images) (,) [q|Image|]
--   & query
-- @
-- qgetMany :: (MonadSystem w m) => (a -> [Entity]) -> Query m b -> Query m a -> Join m a List (From b)
-- qgetMany f b a =
--   Join
--     a
--     ( \_ x -> do
--         let entities = f x
--         y <- catMaybes <$> mapM (\e -> fmap (e,) <$> single (mkGet e b)) entities
--         pure $ map (uncurry From) y
--     )

-- | Like 'qgetMany' but with side-effects in the function which provides the entities.
-- qgetManyM :: (MonadSystem w m) => (a -> m [Entity]) -> Query m b -> Query m a -> Join m a List (From b)
-- qgetManyM f b a =
--   Join
--     a
--     ( \_ x -> do
--         entities <- f x
--         y <- catMaybes <$> mapM (\e -> fmap (e,) <$> single (mkGet e b)) entities
--         pure $ map (uncurry From) y
--     )

-- | Very similar to 'qappendOneM'. This is a helper function mainly intended to make relationship traversals easier.
--
-- __Example__
--
-- @
-- import Mischief.ECS.Relationships.Graph
-- @
--
-- @
-- [q|Name|]
--   & qrelateOne (Graph.outgoing \@ChildOf) (,) [q|Name|]
--   & qinfo (\\(child, parent) -> [i|#{child} is child of #{parent}|])
--   & query_
-- @
-- qrelate :: (MonadSystem w m) => (Entity -> m (Maybe Entity)) -> Query m b -> Query m a -> Join m a Maybe (From b)
-- qrelate f b a =
--   Join
--     a
--     ( \e _ -> do
--         entity <- f e
--         case entity of
--           Nothing -> pure Nothing
--           Just entity -> do
--             y <- single (mkGet entity b)
--             pure $ fmap (From entity) y
--     )

-- | Very similar to 'qappendManyM'. This is a helper function mainly intended to make relationship traversals easier.
--
-- __Example__
--
-- @
-- import Mischief.ECS.Relationships.Graph
-- @
--
-- @
-- [q|Name|]
--   & qrelateOne (Graph.ingoing \@ChildOf) (,) [q|Name|]
--   & qinfo (\\(parent, children) -> [i|#{parent} is parent of #{children}|])
--   & query_
-- @
-- qrelateMany :: (MonadSystem w m) => (Entity -> m [Entity]) -> Query m b -> Query m a -> Join m a List (From b)
-- qrelateMany f b a =
--   Join
--     a
--     ( \e _ -> do
--         entities <- f e
--         y <- catMaybes <$> mapM (\e -> fmap (e,) <$> single (mkGet e b)) (toList entities)
--         pure $ map (uncurry From) y
--     )

-- qjoin :: (MonadSystem w m) => (a -> b -> Bool) -> (a -> From b -> c) -> Query m b -> Query m a -> Query m [c]
-- qjoin f f' a b =
--   mapFilterQuery
--     b
--     ( \_ x -> do
--         y <- query (qentity a)
--         let b = map (\(e, y) -> f' x (From e y)) $ filter (f x . snd) y
--         case b of
--           [] -> pure Nothing
--           b -> pure $ Just b
--     )

-- t :: Query m ()
-- t = do
--   let x :: [a] = undefined
--   for x $ \x -> undefined
--   undefined

-- | Grab the elements from another query that meet a certain condition in relation to this query. Map them together.
-- The entities for which the list is empty will be filtered out.
--
-- __Example__
--
-- @
-- [q|Entity, Name|]
--   & qjoin (\\(e1, n1) (e2, n2) -> n1 == n2 && e1 /= e2) (,) [q|Entity, Name|]
--   & qinfo (\\((e1, name), (e2, _)) -> [i|#{e1} and #{e2} are both named #{name}|])
--   & query_
-- @
-- qcross :: (MonadSystem w m) => (a -> b -> Bool) -> Query m b -> Query m a -> Join m a List (From b)
-- qcross f b a =
--   Join
--     a
--     ( \_ a -> do
--         y <- query (qentity b)
--         let y' = filter (\(_, b) -> f a b) y
--         pure $ map (uncurry From) y'
--     )

-- | Same as 'qcross' but with side effects in the function which matches the elements of the two queries.
-- qcrossM :: (MonadSystem w m) => (Entity -> a -> Entity -> b -> m Bool) -> Query m b -> Query m a -> Join m a List (From b)
-- qcrossM f b a =
--   Join
--     a
--     ( \e a -> do
--         y <- query (qentity b)
--         y' <- filterM (uncurry (f e a)) y
--         pure $ map (uncurry From) y'
--     )

-- | Extends the query with new elements.
--
-- __Example__
--
-- @
-- [q|Name|]
--   & qextend [qd|Position|] (,)
--   & query
-- @
qextend :: (MonadSystem w m, Queryable qd out) => qd -> (a -> out -> c) -> Query m a -> Query m c
qextend :: forall w (m :: * -> *) qd out a c.
(MonadSystem w m, Queryable qd out) =>
qd -> (a -> out -> c) -> Query m a -> Query m c
qextend qd
qd a -> out -> c
f Query m a
a = do
  (e, a) <- Query m a -> Query m (Entity, a)
forall w (m :: * -> *) a.
MonadSystem w m =>
Query m a -> Query m (Entity, a)
qentity Query m a
a
  qget e qd
    & qcollect e
    & qmap (\case [From Entity
_ out
a'] -> a -> out -> c
f a
a out
a'; [From out]
_ -> c
forall a. HasCallStack => a
undefined)

qrelateOne :: (MonadSystem w m, Queryable qd out) => (Entity -> m (Maybe Entity)) -> qd -> (a -> From out -> c) -> Query m a -> Query m c
qrelateOne :: forall w (m :: * -> *) qd out a c.
(MonadSystem w m, Queryable qd out) =>
(Entity -> m (Maybe Entity))
-> qd -> (a -> From out -> c) -> Query m a -> Query m c
qrelateOne Entity -> m (Maybe Entity)
f qd
qd a -> From out -> c
f' Query m a
a = do
  (a, e) <- Query m a
a Query m a
-> (Query m a -> Query m (a, Maybe Entity))
-> Query m (a, Maybe Entity)
forall a b. a -> (a -> b) -> b
& (Entity -> a -> m (a, Maybe Entity))
-> Query m a -> Query m (a, Maybe Entity)
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m b
qtraverse (\Entity
e a
a -> (a
a,) (Maybe Entity -> (a, Maybe Entity))
-> m (Maybe Entity) -> m (a, Maybe Entity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity -> m (Maybe Entity)
f Entity
e)
  case e of
    Maybe Entity
Nothing -> Query m c
forall (m :: * -> *) a. Query m a
EmptyQuery
    Just Entity
e -> do
      out <- Entity -> qd -> Query m out
forall w (m :: * -> *) qd out.
(MonadSystem w m, Queryable qd out) =>
Entity -> qd -> Query m out
qget Entity
e qd
qd
      pure $ f' a (From e out)

qrelateMany :: (MonadSystem w m, Queryable (E, qd) (Entity, out)) => (Entity -> m [Entity]) -> qd -> (a -> [From out] -> c) -> Query m a -> Query m c
qrelateMany :: forall w (m :: * -> *) qd out a c.
(MonadSystem w m, Queryable (E, qd) (Entity, out)) =>
(Entity -> m [Entity])
-> qd -> (a -> [From out] -> c) -> Query m a -> Query m c
qrelateMany Entity -> m [Entity]
f qd
qd a -> [From out] -> c
f' Query m a
a = do
  ((ae, a), e) <- Query m a -> Query m (Entity, a)
forall w (m :: * -> *) a.
MonadSystem w m =>
Query m a -> Query m (Entity, a)
qentity Query m a
a Query m (Entity, a)
-> (Query m (Entity, a) -> Query m ((Entity, a), [Entity]))
-> Query m ((Entity, a), [Entity])
forall a b. a -> (a -> b) -> b
& (Entity -> (Entity, a) -> m ((Entity, a), [Entity]))
-> Query m (Entity, a) -> Query m ((Entity, a), [Entity])
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m b
qtraverse (\Entity
e (Entity, a)
a -> ((Entity, a)
a,) ([Entity] -> ((Entity, a), [Entity]))
-> m [Entity] -> m ((Entity, a), [Entity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity -> m [Entity]
f Entity
e)
  case e of
    [] -> Query m c
forall (m :: * -> *) a. Query m a
EmptyQuery
    [Entity]
e -> do
      as <-
        [Entity] -> (E, qd) -> Query m (Entity, out)
forall w (m :: * -> *) qd out.
(MonadSystem w m, Queryable qd out) =>
[Entity] -> qd -> Query m out
qgetAll [Entity]
e (E
E, qd
qd)
          Query m (Entity, out)
-> (Query m (Entity, out) -> Query m (From out))
-> Query m (From out)
forall a b. a -> (a -> b) -> b
& ((Entity, out) -> From out)
-> Query m (Entity, out) -> Query m (From out)
forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> b) -> Query m a -> Query m b
qmap ((Entity -> out -> From out) -> (Entity, out) -> From out
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Entity -> out -> From out
forall c. Entity -> c -> From c
From)
          Query m (From out)
-> (Query m (From out) -> Query m [From (From out)])
-> Query m [From (From out)]
forall a b. a -> (a -> b) -> b
& Entity -> Query m (From out) -> Query m [From (From out)]
forall w (m :: * -> *) a.
MonadSystem w m =>
Entity -> Query m a -> Query m [From a]
qcollect Entity
ae
          Query m [From (From out)]
-> (Query m [From (From out)] -> Query m [From out])
-> Query m [From out]
forall a b. a -> (a -> b) -> b
& ([From (From out)] -> [From out])
-> Query m [From (From out)] -> Query m [From out]
forall w (m :: * -> *) a b.
MonadSystem w m =>
(a -> b) -> Query m a -> Query m b
qmap ((From (From out) -> From out) -> [From (From out)] -> [From out]
forall a b. (a -> b) -> [a] -> [b]
map (.comp))
      pure $ f' a as

-- | Maps a resource into the query.
--
-- __Example__
--
-- @
-- [q|Name|]
--   & qres \@SomeResource (,)
--   & query
-- @
-- qres :: forall r m a w. (MonadSystem w m, Component r) => Query m a -> Join m a Maybe (Res r)
-- qres = qextend (mkQuery (Res @r))
qres :: forall c m a w. (MonadSystem w m, Component c) => Query m (Res c)
qres :: forall {k} c (m :: * -> *) (a :: k) w.
(MonadSystem w m, Component c) =>
Query m (Res c)
qres = Entity -> (c -> Res c) -> Query m (Res c)
forall w (m :: * -> *) qd out.
(MonadSystem w m, Queryable qd out) =>
Entity -> qd -> Query m out
qget ((# Word#, Word# #) -> Entity
Entity (# Word#
0##, Word#
0## #)) (forall c. c -> Res c
Res @c)

qrefocus :: Entity -> Query m a -> Query m a
qrefocus :: forall (m :: * -> *) a. Entity -> Query m a -> Query m a
qrefocus = (Query m a -> Entity -> Query m a)
-> Entity -> Query m a -> Query m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Query m a -> Entity -> Query m a
forall (m :: * -> *) a. Query m a -> Entity -> Query m a
RefocusQuery

qpure :: (MonadSystem w m) => Entity -> Query m ()
qpure :: forall w (m :: * -> *). MonadSystem w m => Entity -> Query m ()
qpure Entity
e = Entity -> Query m () -> Query m ()
forall (m :: * -> *) a. Entity -> Query m a -> Query m a
qrefocus Entity
e (Query m () -> Query m ()) -> Query m () -> Query m ()
forall a b. (a -> b) -> a -> b
$ () -> Query m ()
forall a. a -> Query m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

--  | Pairs the query's elements with their entity. Same as @qextend (flip (,)) [q|Entity|]@.
qentity :: (MonadSystem w m) => Query m a -> Query m (Entity, a)
qentity :: forall w (m :: * -> *) a.
MonadSystem w m =>
Query m a -> Query m (Entity, a)
qentity = Query m a -> Query m (Entity, a)
forall (m :: * -> *) a1. Query m a1 -> Query m (Entity, a1)
PairEntityQuery

-- mapFilterQuery
--   a
--   ( \_ a -> do
--       m <- tryMeta @r
--       case m of
--         Nothing -> pure Nothing
--         Just m -> do
--           r <- get m $ mkQuery (C @r)
--           case r of
--             Nothing -> pure Nothing
--             Just r -> pure $ Just $ f a r
--   )

-- qtry :: (MonadSystem w m) => ((a -> b -> c) -> Query m a -> Query m c) -> Query m a ->
-- qtry = undefined

qjoin :: (MonadSystem w m) => (a -> Query m b) -> (a -> [From b] -> c) -> Query m a -> Query m c
qjoin :: forall w (m :: * -> *) a b c.
MonadSystem w m =>
(a -> Query m b) -> (a -> [From b] -> c) -> Query m a -> Query m c
qjoin a -> Query m b
f a -> [From b] -> c
f' Query m a
a = do
  (e, a) <- Query m a -> Query m (Entity, a)
forall w (m :: * -> *) a.
MonadSystem w m =>
Query m a -> Query m (Entity, a)
qentity Query m a
a
  f a & qcollect e & qfilter (not . null) & qmap (f' a)

qget :: (MonadSystem w m, Queryable qd out) => Entity -> qd -> Query m out
qget :: forall w (m :: * -> *) qd out.
(MonadSystem w m, Queryable qd out) =>
Entity -> qd -> Query m out
qget Entity
entity qd
qd = qd -> QueryFilter 'ArchetypeFilter -> Maybe [Entity] -> Query m out
forall qd a (m :: * -> *).
Queryable qd a =>
qd -> QueryFilter 'ArchetypeFilter -> Maybe [Entity] -> Query m a
BuildQuery qd
qd QueryFilter 'ArchetypeFilter
forall (f :: FilterType). QueryFilter f
NoFilter ([Entity] -> Maybe [Entity]
forall a. a -> Maybe a
Just [Entity
entity])

qgetAll :: (MonadSystem w m, Queryable qd out) => [Entity] -> qd -> Query m out
qgetAll :: forall w (m :: * -> *) qd out.
(MonadSystem w m, Queryable qd out) =>
[Entity] -> qd -> Query m out
qgetAll [Entity]
entity qd
qd = qd -> QueryFilter 'ArchetypeFilter -> Maybe [Entity] -> Query m out
forall qd a (m :: * -> *).
Queryable qd a =>
qd -> QueryFilter 'ArchetypeFilter -> Maybe [Entity] -> Query m a
BuildQuery qd
qd QueryFilter 'ArchetypeFilter
forall (f :: FilterType). QueryFilter f
NoFilter ([Entity] -> Maybe [Entity]
forall a. a -> Maybe a
Just [Entity]
entity)

-- | Logs an INFO message.
qinfo :: (HasCallStack, MonadSystem w m) => (a -> Text) -> Query m a -> Query m a
qinfo :: forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qinfo a -> Text
f Query m a
a = (HasCallStack => Query m a) -> Query m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Query m a) -> Query m a)
-> (HasCallStack => Query m a) -> Query m a
forall a b. (a -> b) -> a -> b
$ (Entity -> a -> m ()) -> Query m a -> Query m a
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m a
qtap (\Entity
_ a
x -> Text -> m ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
info (a -> Text
f a
x)) Query m a
a

-- | Logs a WARNING message.
qwarn :: (HasCallStack, MonadSystem w m) => (a -> Text) -> Query m a -> Query m a
qwarn :: forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qwarn a -> Text
f Query m a
a = (HasCallStack => Query m a) -> Query m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Query m a) -> Query m a)
-> (HasCallStack => Query m a) -> Query m a
forall a b. (a -> b) -> a -> b
$ (Entity -> a -> m ()) -> Query m a -> Query m a
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m a
qtap (\Entity
_ a
x -> Text -> m ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn (a -> Text
f a
x)) Query m a
a

-- | Logs an ERROR message.
qerr :: (HasCallStack, MonadSystem w m) => (a -> Text) -> Query m a -> Query m a
qerr :: forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qerr a -> Text
f Query m a
a = (HasCallStack => Query m a) -> Query m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Query m a) -> Query m a)
-> (HasCallStack => Query m a) -> Query m a
forall a b. (a -> b) -> a -> b
$ (Entity -> a -> m ()) -> Query m a -> Query m a
forall a (m :: * -> *) b.
(Entity -> a -> m b) -> Query m a -> Query m a
qtap (\Entity
_ a
x -> Text -> m ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
err (a -> Text
f a
x)) Query m a
a

test :: System [(Name, [From Name])]
test :: System [(Name, [From Name])]
test = do
  C Name -> Query System Name
forall qd out (m :: * -> *). Queryable qd out => qd -> Query m out
mkQuery (forall a. C a
forall {k} (a :: k). C a
C @Name)
    Query System Name
-> (Query System Name -> Query System (Name, [From Name]))
-> Query System (Name, [From Name])
forall a b. a -> (a -> b) -> b
& (Name -> Query System Name)
-> (Name -> [From Name] -> (Name, [From Name]))
-> Query System Name
-> Query System (Name, [From Name])
forall w (m :: * -> *) a b c.
MonadSystem w m =>
(a -> Query m b) -> (a -> [From b] -> c) -> Query m a -> Query m c
qjoin (\Name
name -> C Name -> Query System Name
forall qd out (m :: * -> *). Queryable qd out => qd -> Query m out
mkQuery (forall a. C a
forall {k} (a :: k). C a
C @Name) Query System Name
-> (Query System Name -> Query System Name) -> Query System Name
forall a b. a -> (a -> b) -> b
& (Name -> Bool) -> Query System Name -> Query System Name
forall w (m :: * -> *) a.
MonadSystem w m =>
(a -> Bool) -> Query m a -> Query m a
qfilter (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name)) (,)
    Query System (Name, [From Name])
-> (Query System (Name, [From Name])
    -> System [(Name, [From Name])])
-> System [(Name, [From Name])]
forall a b. a -> (a -> b) -> b
& Query System (Name, [From Name]) -> System [(Name, [From Name])]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [out]
query

-- & qcross (==) (mkQuery (C @Name))
-- & qjoin (,)

data Pos = Pos Int deriving (Typeable Pos
[HookRel Pos]
[Hook Pos]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Pos)
(Typeable Pos, IsExclusive (IsExclusiveRel Pos)) =>
Set DefaultComponentType
-> [Hook Pos]
-> [Hook Pos]
-> [Hook Pos]
-> [HookRel Pos]
-> [HookRel Pos]
-> [HookRel Pos]
-> Component Pos
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Pos]
onAdd :: [Hook Pos]
$conSet :: [Hook Pos]
onSet :: [Hook Pos]
$conRemove :: [Hook Pos]
onRemove :: [Hook Pos]
$conAddRel :: [HookRel Pos]
onAddRel :: [HookRel Pos]
$conSetRel :: [HookRel Pos]
onSetRel :: [HookRel Pos]
$conRemoveRel :: [HookRel Pos]
onRemoveRel :: [HookRel Pos]
Component)

data Res1 = Res1 deriving (Typeable Res1
[HookRel Res1]
[Hook Res1]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Res1)
(Typeable Res1, IsExclusive (IsExclusiveRel Res1)) =>
Set DefaultComponentType
-> [Hook Res1]
-> [Hook Res1]
-> [Hook Res1]
-> [HookRel Res1]
-> [HookRel Res1]
-> [HookRel Res1]
-> Component Res1
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Res1]
onAdd :: [Hook Res1]
$conSet :: [Hook Res1]
onSet :: [Hook Res1]
$conRemove :: [Hook Res1]
onRemove :: [Hook Res1]
$conAddRel :: [HookRel Res1]
onAddRel :: [HookRel Res1]
$conSetRel :: [HookRel Res1]
onSetRel :: [HookRel Res1]
$conRemoveRel :: [HookRel Res1]
onRemoveRel :: [HookRel Res1]
Component)

data Res2 = Res2 deriving (Typeable Res2
[HookRel Res2]
[Hook Res2]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Res2)
(Typeable Res2, IsExclusive (IsExclusiveRel Res2)) =>
Set DefaultComponentType
-> [Hook Res2]
-> [Hook Res2]
-> [Hook Res2]
-> [HookRel Res2]
-> [HookRel Res2]
-> [HookRel Res2]
-> Component Res2
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Res2]
onAdd :: [Hook Res2]
$conSet :: [Hook Res2]
onSet :: [Hook Res2]
$conRemove :: [Hook Res2]
onRemove :: [Hook Res2]
$conAddRel :: [HookRel Res2]
onAddRel :: [HookRel Res2]
$conSetRel :: [HookRel Res2]
onSetRel :: [HookRel Res2]
$conRemoveRel :: [HookRel Res2]
onRemoveRel :: [HookRel Res2]
Component)

data Res3 = Res3 deriving (Typeable Res3
[HookRel Res3]
[Hook Res3]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Res3)
(Typeable Res3, IsExclusive (IsExclusiveRel Res3)) =>
Set DefaultComponentType
-> [Hook Res3]
-> [Hook Res3]
-> [Hook Res3]
-> [HookRel Res3]
-> [HookRel Res3]
-> [HookRel Res3]
-> Component Res3
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Res3]
onAdd :: [Hook Res3]
$conSet :: [Hook Res3]
onSet :: [Hook Res3]
$conRemove :: [Hook Res3]
onRemove :: [Hook Res3]
$conAddRel :: [HookRel Res3]
onAddRel :: [HookRel Res3]
$conSetRel :: [HookRel Res3]
onSetRel :: [HookRel Res3]
$conRemoveRel :: [HookRel Res3]
onRemoveRel :: [HookRel Res3]
Component)

data Player = Player deriving (Typeable Player
[HookRel Player]
[Hook Player]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Player)
(Typeable Player, IsExclusive (IsExclusiveRel Player)) =>
Set DefaultComponentType
-> [Hook Player]
-> [Hook Player]
-> [Hook Player]
-> [HookRel Player]
-> [HookRel Player]
-> [HookRel Player]
-> Component Player
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Player]
onAdd :: [Hook Player]
$conSet :: [Hook Player]
onSet :: [Hook Player]
$conRemove :: [Hook Player]
onRemove :: [Hook Player]
$conAddRel :: [HookRel Player]
onAddRel :: [HookRel Player]
$conSetRel :: [HookRel Player]
onSetRel :: [HookRel Player]
$conRemoveRel :: [HookRel Player]
onRemoveRel :: [HookRel Player]
Component)

newtype Coins = Coins Int deriving (Typeable Coins
[HookRel Coins]
[Hook Coins]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Coins)
(Typeable Coins, IsExclusive (IsExclusiveRel Coins)) =>
Set DefaultComponentType
-> [Hook Coins]
-> [Hook Coins]
-> [Hook Coins]
-> [HookRel Coins]
-> [HookRel Coins]
-> [HookRel Coins]
-> Component Coins
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Coins]
onAdd :: [Hook Coins]
$conSet :: [Hook Coins]
onSet :: [Hook Coins]
$conRemove :: [Hook Coins]
onRemove :: [Hook Coins]
$conAddRel :: [HookRel Coins]
onAddRel :: [HookRel Coins]
$conSetRel :: [HookRel Coins]
onSetRel :: [HookRel Coins]
$conRemoveRel :: [HookRel Coins]
onRemoveRel :: [HookRel Coins]
Component)

data Coin = Coin Int deriving (Typeable Coin
[HookRel Coin]
[Hook Coin]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Coin)
(Typeable Coin, IsExclusive (IsExclusiveRel Coin)) =>
Set DefaultComponentType
-> [Hook Coin]
-> [Hook Coin]
-> [Hook Coin]
-> [HookRel Coin]
-> [HookRel Coin]
-> [HookRel Coin]
-> Component Coin
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Coin]
onAdd :: [Hook Coin]
$conSet :: [Hook Coin]
onSet :: [Hook Coin]
$conRemove :: [Hook Coin]
onRemove :: [Hook Coin]
$conAddRel :: [HookRel Coin]
onAddRel :: [HookRel Coin]
$conSetRel :: [HookRel Coin]
onSetRel :: [HookRel Coin]
$conRemoveRel :: [HookRel Coin]
onRemoveRel :: [HookRel Coin]
Component)

data OnTile = OnTile

instance Component OnTile where
  type IsExclusiveRel OnTile = True

gatherCoins :: From Coin -> Int -> Int
gatherCoins :: From Coin -> Int -> Int
gatherCoins (From Entity
_ (Coin Int
value)) Int
total = Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
value

qcollectCoins :: Query System ()
qcollectCoins :: Query System ()
qcollectCoins = do
  (player, coins, From _ tile) <- [q|Entity, Coins, OnTile -> (Entity) / With Player|]

  coinsValue <-
    [q|Coin / With OnTile -> tile|]
      & qtap (\Entity
e Coin
_ -> Entity -> System ()
despawn Entity
e)
      & qfoldr gatherCoins 0 player

  pure coins
    & qinsert (\(Coins Int
x) -> Int -> Coins
Coins (Int -> Coins) -> Int -> Coins
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
coinsValue)
    & void

test' :: System ()
test' :: System ()
test' = do
  Query System (ZonkAny 0) -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System (ZonkAny 0) -> System ())
-> Query System (ZonkAny 0) -> System ()
forall a b. (a -> b) -> a -> b
$ do
    name <- C Name -> Query System Name
forall qd out (m :: * -> *). Queryable qd out => qd -> Query m out
mkQuery (forall a. C a
forall {k} (a :: k). C a
C @Name)

    res1 <- qres @Res1
    res2 <- qres @Res2
    res3 <- qres @Res3

    undefined

-- test' :: System [(Name, Maybe Pos)]
-- test' = do
--   mkQuery (C @Name)
--     & qextend (mkQuery (C @Pos))
--     & qjoinOuter (,)
--     & query