module Mischief.ECS.Relationships.Order where

import Data.Foldable
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Mischief.ECS.Components
import Mischief.ECS.Entities
import Mischief.ECS.Utils
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.Remove

data Before = Before deriving (Typeable Before
[HookRel Before]
[Hook Before]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Before)
(Typeable Before, IsExclusive (IsExclusiveRel Before)) =>
Set DefaultComponentType
-> [Hook Before]
-> [Hook Before]
-> [Hook Before]
-> [HookRel Before]
-> [HookRel Before]
-> [HookRel Before]
-> Component Before
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 Before]
onAdd :: [Hook Before]
$conSet :: [Hook Before]
onSet :: [Hook Before]
$conRemove :: [Hook Before]
onRemove :: [Hook Before]
$conAddRel :: [HookRel Before]
onAddRel :: [HookRel Before]
$conSetRel :: [HookRel Before]
onSetRel :: [HookRel Before]
$conRemoveRel :: [HookRel Before]
onRemoveRel :: [HookRel Before]
Component)

data Visited = Visited deriving (Typeable Visited
[HookRel Visited]
[Hook Visited]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Visited)
(Typeable Visited, IsExclusive (IsExclusiveRel Visited)) =>
Set DefaultComponentType
-> [Hook Visited]
-> [Hook Visited]
-> [Hook Visited]
-> [HookRel Visited]
-> [HookRel Visited]
-> [HookRel Visited]
-> Component Visited
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 Visited]
onAdd :: [Hook Visited]
$conSet :: [Hook Visited]
onSet :: [Hook Visited]
$conRemove :: [Hook Visited]
onRemove :: [Hook Visited]
$conAddRel :: [HookRel Visited]
onAddRel :: [HookRel Visited]
$conSetRel :: [HookRel Visited]
onSetRel :: [HookRel Visited]
$conRemoveRel :: [HookRel Visited]
onRemoveRel :: [HookRel Visited]
Component)

orderEntities :: [Entity] -> System [Entity]
orderEntities :: [Entity] -> System [Entity]
orderEntities [Entity]
entities = do
  res <- Set Entity -> System [Entity]
orderEntitiesStep ([Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
Set.fromList [Entity]
entities)
  for_ entities $ remove (C @Visited)
  -- err $ text res
  return res

orderEntitiesStep :: Set Entity -> System [Entity]
orderEntitiesStep :: Set Entity -> System [Entity]
orderEntitiesStep Set Entity
entities =
  if Set Entity -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Entity
entities
    then
      [Entity] -> System [Entity]
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      next <- String -> Maybe Entity -> Entity
forall a. HasCallStack => String -> Maybe a -> a
expect String
"Attempted to Order Cyclic Graph!" (Maybe Entity -> Entity) -> System (Maybe Entity) -> System Entity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Entity -> System Bool) -> Set Entity -> System (Maybe Entity)
forall (m :: * -> *) a (t :: * -> *).
(Monad m, Foldable t) =>
(a -> m Bool) -> t a -> m (Maybe a)
findM Entity -> System Bool
isAvailable Set Entity
entities
      insert Visited next
      (next :) <$> orderEntitiesStep (Set.delete next entities)

isAvailable :: Entity -> System Bool
isAvailable :: Entity -> System Bool
isAvailable Entity
entity = do
  before <- Query System Entity -> System [Entity]
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m [out]
query (Query System Entity -> System [Entity])
-> Query System Entity -> System [Entity]
forall a b. (a -> b) -> a -> b
$ E -> QueryFilter 'ArchetypeFilter -> Query System Entity
forall qd out (m :: * -> *).
Queryable qd out =>
qd -> QueryFilter 'ArchetypeFilter -> Query m out
mkQuery' E
E (R Before Entity -> QueryFilter 'ArchetypeFilter
forall a (f :: FilterType).
ToFilterComponent a =>
a -> QueryFilter f
With (forall {k} (a :: k) b. b -> R a b
forall a b. b -> R a b
R @Before Entity
entity))
  isNothing <$> findM (\Entity
x -> (Bool -> Bool
not (Bool -> Bool) -> (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> Bool
forall a. HasCallStack => Maybe a -> a
unwrap (Maybe Bool -> Bool) -> System (Maybe Bool) -> System Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (System (Maybe Bool) -> System Bool)
-> System (Maybe Bool) -> System Bool
forall a b. (a -> b) -> a -> b
$ Query System Bool -> System (Maybe Bool)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single (Query System Bool -> System (Maybe Bool))
-> Query System Bool -> System (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Entity -> Has Visited -> Query System Bool
forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> Query m out
mkGet Entity
x (forall a. Has a
forall {k} (a :: k). Has a
Has @Visited)) before