{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Aztecs.ECS.Access
  ( Access,
    AccessT (..),
    MonadAccess (..),
    runAccessT,
  )
where

import Aztecs.ECS.Access.Class (MonadAccess (..))
import Aztecs.ECS.World (World (..))
import qualified Aztecs.ECS.World as W
import Aztecs.ECS.World.Bundle (Bundle)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Identity (Identity)
import Control.Monad.State.Strict (MonadState (..), StateT (..))
import Prelude hiding (all, lookup, map)

type Access = AccessT Identity

-- | Access into the `World`.
newtype AccessT m a = AccessT {forall (m :: * -> *) a. AccessT m a -> StateT World m a
unAccessT :: StateT World m a}
  deriving ((forall a b. (a -> b) -> AccessT m a -> AccessT m b)
-> (forall a b. a -> AccessT m b -> AccessT m a)
-> Functor (AccessT m)
forall a b. a -> AccessT m b -> AccessT m a
forall a b. (a -> b) -> AccessT m a -> AccessT m b
forall (m :: * -> *) a b.
Functor m =>
a -> AccessT m b -> AccessT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AccessT m a -> AccessT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AccessT m a -> AccessT m b
fmap :: forall a b. (a -> b) -> AccessT m a -> AccessT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> AccessT m b -> AccessT m a
<$ :: forall a b. a -> AccessT m b -> AccessT m a
Functor, Functor (AccessT m)
Functor (AccessT m) =>
(forall a. a -> AccessT m a)
-> (forall a b. AccessT m (a -> b) -> AccessT m a -> AccessT m b)
-> (forall a b c.
    (a -> b -> c) -> AccessT m a -> AccessT m b -> AccessT m c)
-> (forall a b. AccessT m a -> AccessT m b -> AccessT m b)
-> (forall a b. AccessT m a -> AccessT m b -> AccessT m a)
-> Applicative (AccessT m)
forall a. a -> AccessT m a
forall a b. AccessT m a -> AccessT m b -> AccessT m a
forall a b. AccessT m a -> AccessT m b -> AccessT m b
forall a b. AccessT m (a -> b) -> AccessT m a -> AccessT m b
forall a b c.
(a -> b -> c) -> AccessT m a -> AccessT m b -> AccessT m c
forall (m :: * -> *). Monad m => Functor (AccessT m)
forall (m :: * -> *) a. Monad m => a -> AccessT m a
forall (m :: * -> *) a b.
Monad m =>
AccessT m a -> AccessT m b -> AccessT m a
forall (m :: * -> *) a b.
Monad m =>
AccessT m a -> AccessT m b -> AccessT m b
forall (m :: * -> *) a b.
Monad m =>
AccessT m (a -> b) -> AccessT m a -> AccessT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> AccessT m a -> AccessT m b -> AccessT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> AccessT m a
pure :: forall a. a -> AccessT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
AccessT m (a -> b) -> AccessT m a -> AccessT m b
<*> :: forall a b. AccessT m (a -> b) -> AccessT m a -> AccessT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> AccessT m a -> AccessT m b -> AccessT m c
liftA2 :: forall a b c.
(a -> b -> c) -> AccessT m a -> AccessT m b -> AccessT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
AccessT m a -> AccessT m b -> AccessT m b
*> :: forall a b. AccessT m a -> AccessT m b -> AccessT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
AccessT m a -> AccessT m b -> AccessT m a
<* :: forall a b. AccessT m a -> AccessT m b -> AccessT m a
Applicative, Applicative (AccessT m)
Applicative (AccessT m) =>
(forall a b. AccessT m a -> (a -> AccessT m b) -> AccessT m b)
-> (forall a b. AccessT m a -> AccessT m b -> AccessT m b)
-> (forall a. a -> AccessT m a)
-> Monad (AccessT m)
forall a. a -> AccessT m a
forall a b. AccessT m a -> AccessT m b -> AccessT m b
forall a b. AccessT m a -> (a -> AccessT m b) -> AccessT m b
forall (m :: * -> *). Monad m => Applicative (AccessT m)
forall (m :: * -> *) a. Monad m => a -> AccessT m a
forall (m :: * -> *) a b.
Monad m =>
AccessT m a -> AccessT m b -> AccessT m b
forall (m :: * -> *) a b.
Monad m =>
AccessT m a -> (a -> AccessT m b) -> AccessT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
AccessT m a -> (a -> AccessT m b) -> AccessT m b
>>= :: forall a b. AccessT m a -> (a -> AccessT m b) -> AccessT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
AccessT m a -> AccessT m b -> AccessT m b
>> :: forall a b. AccessT m a -> AccessT m b -> AccessT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> AccessT m a
return :: forall a. a -> AccessT m a
Monad, Monad (AccessT m)
Monad (AccessT m) =>
(forall a. (a -> AccessT m a) -> AccessT m a)
-> MonadFix (AccessT m)
forall a. (a -> AccessT m a) -> AccessT m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (AccessT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> AccessT m a) -> AccessT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> AccessT m a) -> AccessT m a
mfix :: forall a. (a -> AccessT m a) -> AccessT m a
MonadFix, Monad (AccessT m)
Monad (AccessT m) =>
(forall a. IO a -> AccessT m a) -> MonadIO (AccessT m)
forall a. IO a -> AccessT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (AccessT m)
forall (m :: * -> *) a. MonadIO m => IO a -> AccessT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> AccessT m a
liftIO :: forall a. IO a -> AccessT m a
MonadIO)

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

instance (Monad m) => MonadAccess Bundle (AccessT m) where
  spawn :: Bundle -> AccessT m EntityID
spawn Bundle
b = StateT World m EntityID -> AccessT m EntityID
forall (m :: * -> *) a. StateT World m a -> AccessT m a
AccessT (StateT World m EntityID -> AccessT m EntityID)
-> StateT World m EntityID -> AccessT m EntityID
forall a b. (a -> b) -> a -> b
$ do
    !World
w <- StateT World m World
forall s (m :: * -> *). MonadState s m => m s
get
    let !(EntityID
e, World
w') = Bundle -> World -> (EntityID, World)
W.spawn Bundle
b World
w
    World -> StateT World m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World
w'
    EntityID -> StateT World m EntityID
forall a. a -> StateT World m a
forall (m :: * -> *) a. Monad m => a -> m a
return EntityID
e
  insert :: forall a. Component a => EntityID -> a -> AccessT m ()
insert EntityID
e a
c = StateT World m () -> AccessT m ()
forall (m :: * -> *) a. StateT World m a -> AccessT m a
AccessT (StateT World m () -> AccessT m ())
-> StateT World m () -> AccessT m ()
forall a b. (a -> b) -> a -> b
$ do
    !World
w <- StateT World m World
forall s (m :: * -> *). MonadState s m => m s
get
    let !w' :: World
w' = EntityID -> a -> World -> World
forall a. Component a => EntityID -> a -> World -> World
W.insert EntityID
e a
c World
w
    World -> StateT World m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World
w'
  lookup :: forall a. Component a => EntityID -> AccessT m (Maybe a)
lookup EntityID
e = StateT World m (Maybe a) -> AccessT m (Maybe a)
forall (m :: * -> *) a. StateT World m a -> AccessT m a
AccessT (StateT World m (Maybe a) -> AccessT m (Maybe a))
-> StateT World m (Maybe a) -> AccessT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    !World
w <- StateT World m World
forall s (m :: * -> *). MonadState s m => m s
get
    Maybe a -> StateT World m (Maybe a)
forall a. a -> StateT World m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> StateT World m (Maybe a))
-> Maybe a -> StateT World m (Maybe a)
forall a b. (a -> b) -> a -> b
$ EntityID -> World -> Maybe a
forall a. Component a => EntityID -> World -> Maybe a
W.lookup EntityID
e World
w
  remove :: forall a. Component a => EntityID -> AccessT m (Maybe a)
remove EntityID
e = StateT World m (Maybe a) -> AccessT m (Maybe a)
forall (m :: * -> *) a. StateT World m a -> AccessT m a
AccessT (StateT World m (Maybe a) -> AccessT m (Maybe a))
-> StateT World m (Maybe a) -> AccessT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    !World
w <- StateT World m World
forall s (m :: * -> *). MonadState s m => m s
get
    let !(Maybe a
a, World
w') = EntityID -> World -> (Maybe a, World)
forall a. Component a => EntityID -> World -> (Maybe a, World)
W.remove EntityID
e World
w
    World -> StateT World m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World
w'
    Maybe a -> StateT World m (Maybe a)
forall a. a -> StateT World m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
a
  despawn :: EntityID -> AccessT m ()
despawn EntityID
e = StateT World m () -> AccessT m ()
forall (m :: * -> *) a. StateT World m a -> AccessT m a
AccessT (StateT World m () -> AccessT m ())
-> StateT World m () -> AccessT m ()
forall a b. (a -> b) -> a -> b
$ do
    !World
w <- StateT World m World
forall s (m :: * -> *). MonadState s m => m s
get
    let !(Map ComponentID Dynamic
_, World
w') = EntityID -> World -> (Map ComponentID Dynamic, World)
W.despawn EntityID
e World
w
    World -> StateT World m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World
w'