content: {-# LANGUAGE DeriveFunctor #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  module Aztecs.ECS.Commands where
  
  import Aztecs.ECS.Query.Class
  import Control.Monad.IO.Class
  import Control.Monad.Primitive
  import Control.Monad.Trans
  
  newtype Commands t m a = Commands {unCommands :: m (a, t m ())}
    deriving (Functor)
  
  instance (Monad (t m), Monad m) => Applicative (Commands t m) where
    pure x = Commands $ pure (x, pure ())
    {-# INLINE pure #-}
    Commands mf <*> Commands mx = Commands $ do
      (f, w1) <- mf
      (x, w2) <- mx
      return (f x, w1 >> w2)
    {-# INLINE (<*>) #-}
  
  instance (Monad (t m), Monad m) => Monad (Commands t m) where
    Commands mx >>= f = Commands $ do
      (x, w1) <- mx
      (y, w2) <- unCommands (f x)
      return (y, w1 >> w2)
    {-# INLINE (>>=) #-}
  
  instance (MonadTrans t) => MonadTrans (Commands t) where
    lift m = Commands $ do
      x <- m
      return (x, lift $ pure ())
    {-# INLINE lift #-}
  
  instance (MonadTrans t, Monad (t m), MonadIO m) => MonadIO (Commands t m) where
    liftIO io = Commands $ do
      x <- liftIO io
      return (x, lift $ pure ())
    {-# INLINE liftIO #-}
  
  instance (MonadTrans t, Monad (t m), PrimMonad m) => PrimMonad (Commands t m) where
    type PrimState (Commands t m) = PrimState m
    primitive f = Commands $ do
      x <- primitive f
      return (x, lift $ pure ())
    {-# INLINE primitive #-}
  
  runCommands :: (MonadTrans t, Monad (t m), Monad m) => Commands t m a -> t m a
  runCommands (Commands m) = do
    (result, action) <- lift m
    action
    return result
  {-# INLINE runCommands #-}
  
  queue :: (Applicative m) => t m () -> Commands t m ()
  queue action = Commands $ pure ((), action)
  {-# INLINE queue #-}
  