{-# 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 {forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Commands t m a -> m (a, t m ())
unCommands :: m (a, t m ())}
  deriving ((forall a b. (a -> b) -> Commands t m a -> Commands t m b)
-> (forall a b. a -> Commands t m b -> Commands t m a)
-> Functor (Commands t m)
forall a b. a -> Commands t m b -> Commands t m a
forall a b. (a -> b) -> Commands t m a -> Commands t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor m =>
a -> Commands t m b -> Commands t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> Commands t m a -> Commands t m b
$cfmap :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> Commands t m a -> Commands t m b
fmap :: forall a b. (a -> b) -> Commands t m a -> Commands t m b
$c<$ :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor m =>
a -> Commands t m b -> Commands t m a
<$ :: forall a b. a -> Commands t m b -> Commands t m a
Functor)

instance (Monad (t m), Monad m) => Applicative (Commands t m) where
  pure :: forall a. a -> Commands t m a
pure a
x = m (a, t m ()) -> Commands t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
m (a, t m ()) -> Commands t m a
Commands (m (a, t m ()) -> Commands t m a)
-> m (a, t m ()) -> Commands t m a
forall a b. (a -> b) -> a -> b
$ (a, t m ()) -> m (a, t m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, () -> t m ()
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  {-# INLINE pure #-}
  Commands m (a -> b, t m ())
mf <*> :: forall a b.
Commands t m (a -> b) -> Commands t m a -> Commands t m b
<*> Commands m (a, t m ())
mx = m (b, t m ()) -> Commands t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
m (a, t m ()) -> Commands t m a
Commands (m (b, t m ()) -> Commands t m b)
-> m (b, t m ()) -> Commands t m b
forall a b. (a -> b) -> a -> b
$ do
    (a -> b
f, t m ()
w1) <- m (a -> b, t m ())
mf
    (a
x, t m ()
w2) <- m (a, t m ())
mx
    (b, t m ()) -> m (b, t m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x, t m ()
w1 t m () -> t m () -> t m ()
forall a b. t m a -> t m b -> t m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t m ()
w2)
  {-# INLINE (<*>) #-}

instance (Monad (t m), Monad m) => Monad (Commands t m) where
  Commands m (a, t m ())
mx >>= :: forall a b.
Commands t m a -> (a -> Commands t m b) -> Commands t m b
>>= a -> Commands t m b
f = m (b, t m ()) -> Commands t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
m (a, t m ()) -> Commands t m a
Commands (m (b, t m ()) -> Commands t m b)
-> m (b, t m ()) -> Commands t m b
forall a b. (a -> b) -> a -> b
$ do
    (a
x, t m ()
w1) <- m (a, t m ())
mx
    (b
y, t m ()
w2) <- Commands t m b -> m (b, t m ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Commands t m a -> m (a, t m ())
unCommands (a -> Commands t m b
f a
x)
    (b, t m ()) -> m (b, t m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
y, t m ()
w1 t m () -> t m () -> t m ()
forall a b. t m a -> t m b -> t m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t m ()
w2)
  {-# INLINE (>>=) #-}

instance (MonadTrans t) => MonadTrans (Commands t) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> Commands t m a
lift m a
m = m (a, t m ()) -> Commands t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
m (a, t m ()) -> Commands t m a
Commands (m (a, t m ()) -> Commands t m a)
-> m (a, t m ()) -> Commands t m a
forall a b. (a -> b) -> a -> b
$ do
    a
x <- m a
m
    (a, t m ()) -> m (a, t m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  {-# INLINE lift #-}

instance (MonadTrans t, Monad (t m), MonadIO m) => MonadIO (Commands t m) where
  liftIO :: forall a. IO a -> Commands t m a
liftIO IO a
io = m (a, t m ()) -> Commands t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
m (a, t m ()) -> Commands t m a
Commands (m (a, t m ()) -> Commands t m a)
-> m (a, t m ()) -> Commands t m a
forall a b. (a -> b) -> a -> b
$ do
    a
x <- IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io
    (a, t m ()) -> m (a, t m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  {-# INLINE liftIO #-}

instance (MonadTrans t, Monad (t m), PrimMonad m) => PrimMonad (Commands t m) where
  type PrimState (Commands t m) = PrimState m
  primitive :: forall a.
(State# (PrimState (Commands t m))
 -> (# State# (PrimState (Commands t m)), a #))
-> Commands t m a
primitive State# (PrimState (Commands t m))
-> (# State# (PrimState (Commands t m)), a #)
f = m (a, t m ()) -> Commands t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
m (a, t m ()) -> Commands t m a
Commands (m (a, t m ()) -> Commands t m a)
-> m (a, t m ()) -> Commands t m a
forall a b. (a -> b) -> a -> b
$ do
    a
x <- (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive State# (PrimState m) -> (# State# (PrimState m), a #)
State# (PrimState (Commands t m))
-> (# State# (PrimState (Commands t m)), a #)
f
    (a, t m ()) -> m (a, t m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  {-# INLINE primitive #-}

runCommands :: (MonadTrans t, Monad (t m), Monad m) => Commands t m a -> t m a
runCommands :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
Commands t m a -> t m a
runCommands (Commands m (a, t m ())
m) = do
  (a
result, t m ()
action) <- m (a, t m ()) -> t m (a, t m ())
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (a, t m ())
m
  t m ()
action
  a -> t m a
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
{-# INLINE runCommands #-}

queue :: (Applicative m) => t m () -> Commands t m ()
queue :: forall (m :: * -> *) (t :: (* -> *) -> * -> *).
Applicative m =>
t m () -> Commands t m ()
queue t m ()
action = m ((), t m ()) -> Commands t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
m (a, t m ()) -> Commands t m a
Commands (m ((), t m ()) -> Commands t m ())
-> m ((), t m ()) -> Commands t m ()
forall a b. (a -> b) -> a -> b
$ ((), t m ()) -> m ((), t m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), t m ()
action)
{-# INLINE queue #-}