{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- |
-- Module      : Aztecs.ECS.Access
-- Copyright   : (c) Matt Hunzinger, 2025
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : matt@hunzinger.me
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Aztecs.ECS.Access
  ( Access (..),
    runAccess,
    runAccess_,
    spawn,
    spawn_,
    insert,
    insertUntracked,
    lookup,
    remove,
    despawn,
    system,
    triggerEvent,
    triggerEntityEvent,
  )
where

import Aztecs.ECS.Access.Internal
import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import Aztecs.ECS.System (System (..))
import qualified Aztecs.ECS.System as S
import Aztecs.ECS.World (World)
import qualified Aztecs.ECS.World as W
import Aztecs.ECS.World.Bundle
import qualified Aztecs.ECS.World.Entities as E
import Control.Monad
import Control.Monad.State
import Prelude hiding (all, filter, lookup, map, mapM)

-- | Run an `Access` on a `World`, returning the output and updated `World`.
runAccess :: (Functor m) => Access m a -> World m -> m (a, World m)
runAccess :: forall (m :: * -> *) a.
Functor m =>
Access m a -> World m -> m (a, World m)
runAccess Access m a
a = StateT (World m) m a -> World m -> m (a, World m)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT (World m) m a -> World m -> m (a, World m))
-> StateT (World m) m a -> World m -> m (a, World m)
forall a b. (a -> b) -> a -> b
$ Access m a -> StateT (World m) m a
forall (m :: * -> *) a. Access m a -> StateT (World m) m a
unAccess Access m a
a

-- | Run an `Access` on an empty `World`.
runAccess_ :: (Monad m) => Access m a -> m a
runAccess_ :: forall (m :: * -> *) a. Monad m => Access m a -> m a
runAccess_ Access m a
a = ((a, World m) -> a) -> m (a, World m) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, World m) -> a
forall a b. (a, b) -> a
fst (m (a, World m) -> m a)
-> (World m -> m (a, World m)) -> World m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Access m a -> World m -> m (a, World m)
forall (m :: * -> *) a.
Functor m =>
Access m a -> World m -> m (a, World m)
runAccess Access m a
a (World m -> m a) -> World m -> m a
forall a b. (a -> b) -> a -> b
$ World m
forall (m :: * -> *). World m
W.empty

spawn :: (Monad m) => BundleT m -> Access m EntityID
spawn :: forall (m :: * -> *). Monad m => BundleT m -> Access m EntityID
spawn BundleT m
b = StateT (World m) m EntityID -> Access m EntityID
forall (m :: * -> *) a. StateT (World m) m a -> Access m a
Access (StateT (World m) m EntityID -> Access m EntityID)
-> StateT (World m) m EntityID -> Access m EntityID
forall a b. (a -> b) -> a -> b
$ do
  !World m
w <- StateT (World m) m (World m)
forall s (m :: * -> *). MonadState s m => m s
get
  let (EntityID
e, World m
w', Access m ()
hook) = BundleT m -> World m -> (EntityID, World m, Access m ())
forall (m :: * -> *).
Monad m =>
BundleT m -> World m -> (EntityID, World m, Access m ())
W.spawn BundleT m
b World m
w
  World m -> StateT (World m) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World m
w'
  Access m () -> StateT (World m) m ()
forall (m :: * -> *) a. Access m a -> StateT (World m) m a
unAccess Access m ()
hook
  EntityID -> StateT (World m) m EntityID
forall a. a -> StateT (World m) m a
forall (m :: * -> *) a. Monad m => a -> m a
return EntityID
e

spawn_ :: (Monad m) => BundleT m -> Access m ()
spawn_ :: forall (m :: * -> *). Monad m => BundleT m -> Access m ()
spawn_ = Access m EntityID -> Access m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Access m EntityID -> Access m ())
-> (BundleT m -> Access m EntityID) -> BundleT m -> Access m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BundleT m -> Access m EntityID
forall (m :: * -> *). Monad m => BundleT m -> Access m EntityID
spawn

insert :: (Monad m) => EntityID -> BundleT m -> Access m ()
insert :: forall (m :: * -> *).
Monad m =>
EntityID -> BundleT m -> Access m ()
insert EntityID
e BundleT m
c = StateT (World m) m () -> Access m ()
forall (m :: * -> *) a. StateT (World m) m a -> Access m a
Access (StateT (World m) m () -> Access m ())
-> StateT (World m) m () -> Access m ()
forall a b. (a -> b) -> a -> b
$ do
  !World m
w <- StateT (World m) m (World m)
forall s (m :: * -> *). MonadState s m => m s
get
  let (World m
w', Access m ()
hook) = EntityID -> BundleT m -> World m -> (World m, Access m ())
forall (m :: * -> *).
Monad m =>
EntityID -> BundleT m -> World m -> (World m, Access m ())
W.insert EntityID
e BundleT m
c World m
w
  World m -> StateT (World m) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World m
w'
  Access m () -> StateT (World m) m ()
forall (m :: * -> *) a. Access m a -> StateT (World m) m a
unAccess Access m ()
hook

-- | Insert a component into an entity without running lifecycle hooks.
insertUntracked :: (Monad m) => EntityID -> BundleT m -> Access m ()
insertUntracked :: forall (m :: * -> *).
Monad m =>
EntityID -> BundleT m -> Access m ()
insertUntracked EntityID
e BundleT m
c = StateT (World m) m () -> Access m ()
forall (m :: * -> *) a. StateT (World m) m a -> Access m a
Access (StateT (World m) m () -> Access m ())
-> StateT (World m) m () -> Access m ()
forall a b. (a -> b) -> a -> b
$ do
  !World m
w <- StateT (World m) m (World m)
forall s (m :: * -> *). MonadState s m => m s
get
  let w' :: World m
w' = EntityID -> BundleT m -> World m -> World m
forall (m :: * -> *).
Monad m =>
EntityID -> BundleT m -> World m -> World m
W.insertUntracked EntityID
e BundleT m
c World m
w
  World m -> StateT (World m) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World m
w'

lookup :: forall m a. (Monad m, Component m a) => EntityID -> Access m (Maybe a)
lookup :: forall (m :: * -> *) a.
(Monad m, Component m a) =>
EntityID -> Access m (Maybe a)
lookup EntityID
e = StateT (World m) m (Maybe a) -> Access m (Maybe a)
forall (m :: * -> *) a. StateT (World m) m a -> Access m a
Access (StateT (World m) m (Maybe a) -> Access m (Maybe a))
-> StateT (World m) m (Maybe a) -> Access m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
  !World m
w <- StateT (World m) m (World m)
forall s (m :: * -> *). MonadState s m => m s
get
  Maybe a -> StateT (World m) m (Maybe a)
forall a. a -> StateT (World m) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> StateT (World m) m (Maybe a))
-> Maybe a -> StateT (World m) m (Maybe a)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Component m a =>
EntityID -> World m -> Maybe a
W.lookup @m EntityID
e World m
w

remove :: forall m a. (Monad m, Component m a) => EntityID -> Access m (Maybe a)
remove :: forall (m :: * -> *) a.
(Monad m, Component m a) =>
EntityID -> Access m (Maybe a)
remove EntityID
e = StateT (World m) m (Maybe a) -> Access m (Maybe a)
forall (m :: * -> *) a. StateT (World m) m a -> Access m a
Access (StateT (World m) m (Maybe a) -> Access m (Maybe a))
-> StateT (World m) m (Maybe a) -> Access m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
  !World m
w <- StateT (World m) m (World m)
forall s (m :: * -> *). MonadState s m => m s
get
  let (Maybe a
a, World m
w', Access m ()
hook) = forall (m :: * -> *) a.
Component m a =>
EntityID -> World m -> (Maybe a, World m, Access m ())
W.remove @m EntityID
e World m
w
  World m -> StateT (World m) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World m
w'
  Access m () -> StateT (World m) m ()
forall (m :: * -> *) a. Access m a -> StateT (World m) m a
unAccess Access m ()
hook
  Maybe a -> StateT (World m) m (Maybe a)
forall a. a -> StateT (World m) m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
a

despawn :: (Monad m) => EntityID -> Access m ()
despawn :: forall (m :: * -> *). Monad m => EntityID -> Access m ()
despawn EntityID
e = StateT (World m) m () -> Access m ()
forall (m :: * -> *) a. StateT (World m) m a -> Access m a
Access (StateT (World m) m () -> Access m ())
-> StateT (World m) m () -> Access m ()
forall a b. (a -> b) -> a -> b
$ do
  !World m
w <- StateT (World m) m (World m)
forall s (m :: * -> *). MonadState s m => m s
get
  let !(IntMap Dynamic
_, World m
w') = EntityID -> World m -> (IntMap Dynamic, World m)
forall (m :: * -> *).
EntityID -> World m -> (IntMap Dynamic, World m)
W.despawn EntityID
e World m
w
  World m -> StateT (World m) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World m
w'

-- | Run a `System` on the `World`.
system :: (Monad m) => System m a -> Access m a
system :: forall (m :: * -> *) a. Monad m => System m a -> Access m a
system System m a
sys = StateT (World m) m a -> Access m a
forall (m :: * -> *) a. StateT (World m) m a -> Access m a
Access (StateT (World m) m a -> Access m a)
-> StateT (World m) m a -> Access m a
forall a b. (a -> b) -> a -> b
$ do
  !World m
w <- StateT (World m) m (World m)
forall s (m :: * -> *). MonadState s m => m s
get
  let !es :: Entities m
es = World m -> Entities m
forall (m :: * -> *). World m -> Entities m
W.entities World m
w
      !(Components
cs', DynamicSystem m a
dynSys) = System m a -> Components -> (Components, DynamicSystem m a)
forall (m :: * -> *) a.
System m a -> Components -> (Components, DynamicSystem m a)
S.runSystem System m a
sys (Components -> (Components, DynamicSystem m a))
-> Components -> (Components, DynamicSystem m a)
forall a b. (a -> b) -> a -> b
$ Entities m -> Components
forall (m :: * -> *). Entities m -> Components
E.components Entities m
es
  (a
a, Entities m
es', Access m ()
hook) <- m (a, Entities m, Access m ())
-> StateT (World m) m (a, Entities m, Access m ())
forall (m :: * -> *) a. Monad m => m a -> StateT (World m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, Entities m, Access m ())
 -> StateT (World m) m (a, Entities m, Access m ()))
-> m (a, Entities m, Access m ())
-> StateT (World m) m (a, Entities m, Access m ())
forall a b. (a -> b) -> a -> b
$ DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())
forall (m :: * -> *) a.
Monad m =>
DynamicSystem m a -> Entities m -> m (a, Entities m, Access m ())
S.runDynamicSystem DynamicSystem m a
dynSys Entities m
es
  World m -> StateT (World m) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World m
w {W.entities = es' {E.components = cs'}}
  Access m () -> StateT (World m) m ()
forall (m :: * -> *) a. Access m a -> StateT (World m) m a
unAccess Access m ()
hook
  a -> StateT (World m) m a
forall a. a -> StateT (World m) m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINE system #-}