{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.Aztecs.Command
  ( Command (..),
    spawn,
    insert,
    Edit (..),
  )
where

import Control.Monad.IO.Class
import Control.Monad.State (StateT (..))
import qualified Control.Monad.State as S
import Data.Aztecs.World (Component, Entity, World)
import qualified Data.Aztecs.World as W
import Data.Dynamic (Typeable)
import Data.Proxy
import Prelude hiding (all)

data Edit where
  Spawn :: (Component c) => Entity -> (Proxy c) -> Edit
  Insert :: (Component c) => Entity -> (Proxy c) -> Edit

-- | Command to update the `World`.
newtype Command m a = Command (StateT World m a)
  deriving ((forall a b. (a -> b) -> Command m a -> Command m b)
-> (forall a b. a -> Command m b -> Command m a)
-> Functor (Command m)
forall a b. a -> Command m b -> Command m a
forall a b. (a -> b) -> Command m a -> Command m b
forall (m :: * -> *) a b.
Functor m =>
a -> Command m b -> Command m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Command m a -> Command 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) -> Command m a -> Command m b
fmap :: forall a b. (a -> b) -> Command m a -> Command m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Command m b -> Command m a
<$ :: forall a b. a -> Command m b -> Command m a
Functor, Functor (Command m)
Functor (Command m) =>
(forall a. a -> Command m a)
-> (forall a b. Command m (a -> b) -> Command m a -> Command m b)
-> (forall a b c.
    (a -> b -> c) -> Command m a -> Command m b -> Command m c)
-> (forall a b. Command m a -> Command m b -> Command m b)
-> (forall a b. Command m a -> Command m b -> Command m a)
-> Applicative (Command m)
forall a. a -> Command m a
forall a b. Command m a -> Command m b -> Command m a
forall a b. Command m a -> Command m b -> Command m b
forall a b. Command m (a -> b) -> Command m a -> Command m b
forall a b c.
(a -> b -> c) -> Command m a -> Command m b -> Command m c
forall (m :: * -> *). Monad m => Functor (Command m)
forall (m :: * -> *) a. Monad m => a -> Command m a
forall (m :: * -> *) a b.
Monad m =>
Command m a -> Command m b -> Command m a
forall (m :: * -> *) a b.
Monad m =>
Command m a -> Command m b -> Command m b
forall (m :: * -> *) a b.
Monad m =>
Command m (a -> b) -> Command m a -> Command m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Command m a -> Command m b -> Command 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 -> Command m a
pure :: forall a. a -> Command m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
Command m (a -> b) -> Command m a -> Command m b
<*> :: forall a b. Command m (a -> b) -> Command m a -> Command m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Command m a -> Command m b -> Command m c
liftA2 :: forall a b c.
(a -> b -> c) -> Command m a -> Command m b -> Command m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
Command m a -> Command m b -> Command m b
*> :: forall a b. Command m a -> Command m b -> Command m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
Command m a -> Command m b -> Command m a
<* :: forall a b. Command m a -> Command m b -> Command m a
Applicative, Applicative (Command m)
Applicative (Command m) =>
(forall a b. Command m a -> (a -> Command m b) -> Command m b)
-> (forall a b. Command m a -> Command m b -> Command m b)
-> (forall a. a -> Command m a)
-> Monad (Command m)
forall a. a -> Command m a
forall a b. Command m a -> Command m b -> Command m b
forall a b. Command m a -> (a -> Command m b) -> Command m b
forall (m :: * -> *). Monad m => Applicative (Command m)
forall (m :: * -> *) a. Monad m => a -> Command m a
forall (m :: * -> *) a b.
Monad m =>
Command m a -> Command m b -> Command m b
forall (m :: * -> *) a b.
Monad m =>
Command m a -> (a -> Command m b) -> Command 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 =>
Command m a -> (a -> Command m b) -> Command m b
>>= :: forall a b. Command m a -> (a -> Command m b) -> Command m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Command m a -> Command m b -> Command m b
>> :: forall a b. Command m a -> Command m b -> Command m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> Command m a
return :: forall a. a -> Command m a
Monad, Monad (Command m)
Monad (Command m) =>
(forall a. IO a -> Command m a) -> MonadIO (Command m)
forall a. IO a -> Command m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (Command m)
forall (m :: * -> *) a. MonadIO m => IO a -> Command m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Command m a
liftIO :: forall a. IO a -> Command m a
MonadIO)

-- | Spawn a `Component` and return its `Entity`.
spawn :: (Component a, Typeable a) => a -> Command IO Entity
spawn :: forall a. (Component a, Typeable a) => a -> Command IO Entity
spawn a
a = StateT World IO Entity -> Command IO Entity
forall (m :: * -> *) a. StateT World m a -> Command m a
Command (StateT World IO Entity -> Command IO Entity)
-> StateT World IO Entity -> Command IO Entity
forall a b. (a -> b) -> a -> b
$ do
  World
w <- StateT World IO World
forall s (m :: * -> *). MonadState s m => m s
S.get
  (Entity
e, World
w') <- IO (Entity, World) -> StateT World IO (Entity, World)
forall a. IO a -> StateT World IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Entity, World) -> StateT World IO (Entity, World))
-> IO (Entity, World) -> StateT World IO (Entity, World)
forall a b. (a -> b) -> a -> b
$ a -> World -> IO (Entity, World)
forall c. Component c => c -> World -> IO (Entity, World)
W.spawn a
a World
w
  World -> StateT World IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
S.put (World -> StateT World IO ()) -> World -> StateT World IO ()
forall a b. (a -> b) -> a -> b
$ World
w'
  Entity -> StateT World IO Entity
forall a. a -> StateT World IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e

-- | Insert a `Component` into an `Entity`.
insert :: (Component a, Typeable a) => Entity -> a -> Command IO ()
insert :: forall a. (Component a, Typeable a) => Entity -> a -> Command IO ()
insert Entity
e a
a =  StateT World IO () -> Command IO ()
forall (m :: * -> *) a. StateT World m a -> Command m a
Command (StateT World IO () -> Command IO ())
-> StateT World IO () -> Command IO ()
forall a b. (a -> b) -> a -> b
$ do
  World
w <- StateT World IO World
forall s (m :: * -> *). MonadState s m => m s
S.get
  World
w' <- IO World -> StateT World IO World
forall a. IO a -> StateT World IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO World -> StateT World IO World)
-> IO World -> StateT World IO World
forall a b. (a -> b) -> a -> b
$ Entity -> a -> World -> IO World
forall c. Component c => Entity -> c -> World -> IO World
W.insert Entity
e a
a World
w
  World -> StateT World IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
S.put World
w'