{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.Relationships.Tree where

import Mischief.ECS.Components
import Mischief.ECS.Components.BundleTypes
import Mischief.ECS.Entities
import Mischief.ECS.Relationships.Graph
import Mischief.ECS.World

descendants :: forall c m w. (Component c, BundleTypes c, MonadSystem w m) => Entity -> m [Entity]
descendants :: forall c (m :: * -> *) w.
(Component c, BundleTypes c, MonadSystem w m) =>
Entity -> m [Entity]
descendants Entity
entity = do
  next <- forall c (m :: * -> *) w.
(Component c, BundleTypes c, MonadSystem w m) =>
Entity -> m [Entity]
incoming @c Entity
entity
  next' <- mapM (descendants @c) next
  pure $ next ++ concat next'

ancestors' :: forall c m w. (Component c, MonadSystem w m) => Entity -> m [Entity]
ancestors' :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
Entity -> m [Entity]
ancestors' Entity
entity = do
  next <- forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
Entity -> m [Entity]
outgoing' @c Entity
entity
  x <- mapM (ancestors' @c) next
  pure $ concat (next : x)

ancestors :: forall c m w. (Component c, MonadSystem w m, ListToOutgoing (RelOutgoing (IsExclusiveRel c) Entity)) => Entity -> m (RelOutgoing (IsExclusiveRel c) Entity)
ancestors :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m,
 ListToOutgoing (RelOutgoing (IsExclusiveRel c) Entity)) =>
Entity -> m (RelOutgoing (IsExclusiveRel c) Entity)
ancestors Entity
e = [Entity] -> RelOutgoing (IsExclusiveRel c) Entity
forall b. ListToOutgoing b => [Entity] -> b
listToOutgoing ([Entity] -> RelOutgoing (IsExclusiveRel c) Entity)
-> m [Entity] -> m (RelOutgoing (IsExclusiveRel c) Entity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
Entity -> m [Entity]
ancestors' @c Entity
e

root :: forall c m w. (Component c, MonadSystem w m) => Entity -> m (Maybe Entity)
root :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
Entity -> m (Maybe Entity)
root Entity
entity = do
  out <- forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
Entity -> m [Entity]
outgoing' @c Entity
entity
  case out of
    [] -> Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Entity -> m (Maybe Entity))
-> Maybe Entity -> m (Maybe Entity)
forall a b. (a -> b) -> a -> b
$ Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
entity
    [Entity
p] -> forall c (m :: * -> *) w.
(Component c, MonadSystem w m) =>
Entity -> m (Maybe Entity)
root @c Entity
p
    [Entity]
_ -> m (Maybe Entity)
forall a. HasCallStack => a
undefined

leaves :: forall c m w. (Component c, BundleTypes c, MonadSystem w m) => Entity -> m [Entity]
leaves :: forall c (m :: * -> *) w.
(Component c, BundleTypes c, MonadSystem w m) =>
Entity -> m [Entity]
leaves Entity
entity = do
  ing <- forall c (m :: * -> *) w.
(Component c, BundleTypes c, MonadSystem w m) =>
Entity -> m [Entity]
incoming @c Entity
entity
  case ing of
    [] -> [Entity] -> m [Entity]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Entity
entity]
    [Entity]
l -> do
      l' <- (Entity -> m [Entity]) -> [Entity] -> m [[Entity]]
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 (forall c (m :: * -> *) w.
(Component c, BundleTypes c, MonadSystem w m) =>
Entity -> m [Entity]
leaves @c) [Entity]
l
      pure $ concat l'