-- |
-- Module      :  Games.ECS.System
-- Description : System definitions
-- Copyright   :  (C) 2020 Sophie Taylor
-- License     :  AGPL-3.0-or-later
-- Maintainer  :  Sophie Taylor <sophie@spacekitteh.moe>
-- Stability   :  experimental
-- Portability: GHC
--
-- Infrastructure for defining ECS Systems.
module Games.ECS.System where

import Control.Lens
import Data.Kind
import Data.Proxy
import Debug.Trace
import GHC.TypeLits
import Games.ECS.Entity
import Games.ECS.World

-- TODO: Generate a "UsingSystem" class a la UsingComponents

-- type SystemFunc w = World w => w Storing -> w Storing
-- type IndividualFunc m w = (World w, MonadState (w Storing) m) => m (w Individual) -> m (w Individual)

-- | A system which operates on entities which matches certain constraints on components.
class (World w, Monad m, KnownSymbol (AppendSymbol name " started"), KnownSymbol (AppendSymbol name " finished")) => System (name :: Symbol) sys w m | name -> sys, sys -> name where
  -- Remember to use '[] rather than [] to specify type-level lists!

  -- | What this systems runs after
  type RunsAfter sys :: [Symbol]

  type RunsAfter sys = '[]

  -- | What this systems runs before
  type RunsBefore sys :: [Symbol]

  type RunsBefore sys = '[]

  -- | Constraints required to run the system.
  type ComponentFilters name sys w m :: Constraint

  type ComponentFilters name sys w m = ()

  -- | The filter on components which the system affects
  componentFilter :: (ComponentFilters name sys w m, Monoid r) => Getting r (w Storing) IntersectionOfEntities
  componentFilter = Getting r (w 'Storing) IntersectionOfEntities
forall a. Monoid a => a
mempty

  -- | Should this entity be processed?
  processPredicate :: (ComponentFilters name sys w m) => w Individual -> Bool
  processPredicate = Bool -> w 'Individual -> Bool
forall a b. a -> b -> a
const Bool
True

  -- | Process a single entity
  processEntity :: (ComponentFilters name sys w m) => w Individual -> m (w Individual)
  processEntity = w 'Individual -> m (w 'Individual)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  -- | Initialise the system with preliminary data based on a fresh world. The system is allowed to modify the
  -- world if it wishes.
  initialiseSystem :: w Storing -> m (w Storing)
  initialiseSystem = w 'Storing -> m (w 'Storing)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  -- | Run the system. By default, it runs `processEntity` for each entity.
  runSystem :: (ComponentFilters name sys w m) => w Storing -> m (w Storing)
  runSystem w 'Storing
world = do
    String -> m () -> m ()
forall a. String -> a -> a
traceMarker (Proxy (AppendSymbol name " started") -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (AppendSymbol name " started")
forall {k} (t :: k). Proxy t
Proxy :: Proxy (AppendSymbol name " started"))) (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    w 'Storing
processedWorld <- LensLike
  m (w 'Storing) (w 'Storing) (w 'Individual) (w 'Individual)
-> LensLike
     m (w 'Storing) (w 'Storing) (w 'Individual) (w 'Individual)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((forall r.
 Monoid r =>
 Getting r (w 'Storing) IntersectionOfEntities)
-> LensLike
     m (w 'Storing) (w 'Storing) (w 'Individual) (w 'Individual)
forall (f :: * -> *) (p :: * -> * -> *).
(Indexable Entity p, Applicative f) =>
(forall r.
 Monoid r =>
 Getting r (w 'Storing) IntersectionOfEntities)
-> p (w 'Individual) (f (w 'Individual))
-> w 'Storing
-> f (w 'Storing)
forall (w :: Access -> *) (f :: * -> *) (p :: * -> * -> *).
(World w, Indexable Entity p, Applicative f) =>
(forall r.
 Monoid r =>
 Getting r (w 'Storing) IntersectionOfEntities)
-> p (w 'Individual) (f (w 'Individual))
-> w 'Storing
-> f (w 'Storing)
entitiesWith (forall {k} (name :: Symbol) (sys :: k) (w :: Access -> *)
       (m :: * -> *) r.
(System name sys w m, ComponentFilters name sys w m, Monoid r) =>
Getting r (w 'Storing) IntersectionOfEntities
forall (name :: Symbol) (sys :: k) (w :: Access -> *) (m :: * -> *)
       r.
(System name sys w m, ComponentFilters name sys w m, Monoid r) =>
Getting r (w 'Storing) IntersectionOfEntities
componentFilter @name @sys @w @m) LensLike
  m (w 'Storing) (w 'Storing) (w 'Individual) (w 'Individual)
-> ((w 'Individual -> m (w 'Individual))
    -> w 'Individual -> m (w 'Individual))
-> LensLike
     m (w 'Storing) (w 'Storing) (w 'Individual) (w 'Individual)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w 'Individual -> Bool)
-> (w 'Individual -> m (w 'Individual))
-> w 'Individual
-> m (w 'Individual)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (forall {k} (name :: Symbol) (sys :: k) (w :: Access -> *)
       (m :: * -> *).
(System name sys w m, ComponentFilters name sys w m) =>
w 'Individual -> Bool
forall (name :: Symbol) (sys :: k) (w :: Access -> *)
       (m :: * -> *).
(System name sys w m, ComponentFilters name sys w m) =>
w 'Individual -> Bool
processPredicate @name @sys @w @m)) (forall {k} (name :: Symbol) (sys :: k) (w :: Access -> *)
       (m :: * -> *).
(System name sys w m, ComponentFilters name sys w m) =>
w 'Individual -> m (w 'Individual)
forall (name :: Symbol) (sys :: k) (w :: Access -> *)
       (m :: * -> *).
(System name sys w m, ComponentFilters name sys w m) =>
w 'Individual -> m (w 'Individual)
processEntity @name) w 'Storing
world
    w 'Storing
finished <- forall {k} (name :: Symbol) (sys :: k) (w :: Access -> *)
       (m :: * -> *).
(System name sys w m, ComponentFilters name sys w m) =>
w 'Storing -> m (w 'Storing)
forall (name :: Symbol) (sys :: k) (w :: Access -> *)
       (m :: * -> *).
(System name sys w m, ComponentFilters name sys w m) =>
w 'Storing -> m (w 'Storing)
postTickCleanup @name @sys w 'Storing
processedWorld
    String -> m (w 'Storing) -> m (w 'Storing)
forall a. String -> a -> a
traceMarker (Proxy (AppendSymbol name " started") -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (AppendSymbol name " started")
forall {k} (t :: k). Proxy t
Proxy :: Proxy (AppendSymbol name " started"))) (w 'Storing -> m (w 'Storing)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure w 'Storing
finished)

  -- | Run any cleanup necessary at the end of a tick, such as clearing cached data only necessary for the tick, or marking things as dirty.
  postTickCleanup :: (ComponentFilters name sys w m) => w Storing -> m (w Storing)
  postTickCleanup = w 'Storing -> m (w 'Storing)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  -- | Ran after the effect system has finished. This is so that one can, for example, collect all effects to
  -- apply during the effect system processing; and once all effects are collected, apply them all at once.
  -- This can eliminate redundant processing, as well as later effects not overriding previously-processed
  -- effects.
  runAfterEffects :: w Storing -> m (w Storing)
  runAfterEffects = w 'Storing -> m (w 'Storing)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{-
collectGarbage :: SystemFunc w
collectGarbage = undefined

markUselessEntitiesForDeletion :: (Foldable f, World w) => w Storing -> f Entity
markUselessEntitiesForDeletion = undefined

removeMarked :: Foldable f => f Entity -> SystemFunc w
removeMarked = undefined
-}