{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Aztecs.ECS.Executor where

import Aztecs.ECS.Access.Internal
import Aztecs.ECS.HSet
import Aztecs.ECS.System

newtype ExecutorT m a = ExecutorT {forall (m :: * -> *) a. ExecutorT m a -> ([m ()] -> m ()) -> m a
runSystems :: ([m ()] -> m ()) -> m a}
  deriving ((forall a b. (a -> b) -> ExecutorT m a -> ExecutorT m b)
-> (forall a b. a -> ExecutorT m b -> ExecutorT m a)
-> Functor (ExecutorT m)
forall a b. a -> ExecutorT m b -> ExecutorT m a
forall a b. (a -> b) -> ExecutorT m a -> ExecutorT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ExecutorT m b -> ExecutorT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExecutorT m a -> ExecutorT 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) -> ExecutorT m a -> ExecutorT m b
fmap :: forall a b. (a -> b) -> ExecutorT m a -> ExecutorT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ExecutorT m b -> ExecutorT m a
<$ :: forall a b. a -> ExecutorT m b -> ExecutorT m a
Functor)

instance (Applicative m) => Applicative (ExecutorT m) where
  pure :: forall a. a -> ExecutorT m a
pure a
x = (([m ()] -> m ()) -> m a) -> ExecutorT m a
forall (m :: * -> *) a. (([m ()] -> m ()) -> m a) -> ExecutorT m a
ExecutorT ((([m ()] -> m ()) -> m a) -> ExecutorT m a)
-> (([m ()] -> m ()) -> m a) -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ \[m ()] -> m ()
_ -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  {-# INLINE pure #-}
  ExecutorT ([m ()] -> m ()) -> m (a -> b)
f <*> :: forall a b. ExecutorT m (a -> b) -> ExecutorT m a -> ExecutorT m b
<*> ExecutorT ([m ()] -> m ()) -> m a
g = (([m ()] -> m ()) -> m b) -> ExecutorT m b
forall (m :: * -> *) a. (([m ()] -> m ()) -> m a) -> ExecutorT m a
ExecutorT ((([m ()] -> m ()) -> m b) -> ExecutorT m b)
-> (([m ()] -> m ()) -> m b) -> ExecutorT m b
forall a b. (a -> b) -> a -> b
$ \[m ()] -> m ()
run -> ([m ()] -> m ()) -> m (a -> b)
f [m ()] -> m ()
run m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([m ()] -> m ()) -> m a
g [m ()] -> m ()
run
  {-# INLINE (<*>) #-}

instance (Monad m) => Monad (ExecutorT m) where
  ExecutorT ([m ()] -> m ()) -> m a
f >>= :: forall a b. ExecutorT m a -> (a -> ExecutorT m b) -> ExecutorT m b
>>= a -> ExecutorT m b
g = (([m ()] -> m ()) -> m b) -> ExecutorT m b
forall (m :: * -> *) a. (([m ()] -> m ()) -> m a) -> ExecutorT m a
ExecutorT ((([m ()] -> m ()) -> m b) -> ExecutorT m b)
-> (([m ()] -> m ()) -> m b) -> ExecutorT m b
forall a b. (a -> b) -> a -> b
$ \[m ()] -> m ()
run -> ([m ()] -> m ()) -> m a
f [m ()] -> m ()
run m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> ExecutorT m b -> ([m ()] -> m ()) -> m b
forall (m :: * -> *) a. ExecutorT m a -> ([m ()] -> m ()) -> m a
runSystems (a -> ExecutorT m b
g a
x) [m ()] -> m ()
run
  {-# INLINE (>>=) #-}

class Execute' m s where
  execute' :: s -> [m ()]

instance Execute' m (HSet '[]) where
  execute' :: HSet '[] -> [m ()]
execute' HSet '[]
_ = []
  {-# INLINE execute' #-}

instance
  {-# OVERLAPS #-}
  ( Monad m,
    System m sys,
    Access m (SystemIn m sys),
    ValidAccessInput (AccessType (SystemIn m sys))
  ) =>
  Execute' m (HSet '[sys])
  where
  execute' :: HSet '[sys] -> [m ()]
execute' (HCons t
system HSet ts1
HEmpty) = [m (SystemIn m sys)
forall (m :: * -> *) a. Access m a => m a
access m (SystemIn m sys) -> (SystemIn m sys -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> SystemIn m t -> m ()
forall (m :: * -> *) sys.
System m sys =>
sys -> SystemIn m sys -> m ()
runSystem t
system]
  {-# INLINE execute' #-}

instance
  {-# OVERLAPPABLE #-}
  ( Monad m,
    System m sys,
    Access m (SystemIn m sys),
    ValidAccessInput (AccessType (SystemIn m sys)),
    Execute' m (HSet systems)
  ) =>
  Execute' m (HSet (sys ': systems))
  where
  execute' :: HSet (sys : systems) -> [m ()]
execute' (HCons t
s HSet ts1
rest) = (m (SystemIn m sys)
forall (m :: * -> *) a. Access m a => m a
access m (SystemIn m sys) -> (SystemIn m sys -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> SystemIn m t -> m ()
forall (m :: * -> *) sys.
System m sys =>
sys -> SystemIn m sys -> m ()
runSystem t
s) m () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
: HSet ts1 -> [m ()]
forall (m :: * -> *) s. Execute' m s => s -> [m ()]
execute' HSet ts1
rest
  {-# INLINE execute' #-}

class Execute m s where
  execute :: s -> ExecutorT m ()

instance (Applicative m) => Execute m (HSet '[]) where
  execute :: HSet '[] -> ExecutorT m ()
execute HSet '[]
_ = () -> ExecutorT m ()
forall a. a -> ExecutorT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINE execute #-}

instance
  {-# OVERLAPPING #-}
  (Monad m, Execute' m systems, Execute m (HSet schedule)) =>
  Execute m (HSet (systems ': schedule))
  where
  execute :: HSet (systems : schedule) -> ExecutorT m ()
execute (HCons t
system HSet ts1
rest) = do
    (([m ()] -> m ()) -> m ()) -> ExecutorT m ()
forall (m :: * -> *) a. (([m ()] -> m ()) -> m a) -> ExecutorT m a
ExecutorT ((([m ()] -> m ()) -> m ()) -> ExecutorT m ())
-> (([m ()] -> m ()) -> m ()) -> ExecutorT m ()
forall a b. (a -> b) -> a -> b
$ \[m ()] -> m ()
run -> [m ()] -> m ()
run ([m ()] -> m ()) -> [m ()] -> m ()
forall a b. (a -> b) -> a -> b
$ t -> [m ()]
forall (m :: * -> *) s. Execute' m s => s -> [m ()]
execute' t
system
    HSet ts1 -> ExecutorT m ()
forall (m :: * -> *) s. Execute m s => s -> ExecutorT m ()
execute HSet ts1
rest
  {-# INLINE execute #-}