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

module Data.Aztecs.Task
  ( Task (..),
    command,
    runTask,
  )
where

import Control.Monad.IO.Class
import Control.Monad.State (StateT (..))
import qualified Control.Monad.State as S
import Data.Aztecs.Command
import Data.Aztecs.World (World)
import Prelude hiding (all)

-- | System task.
newtype Task m s a = Task (StateT (s, [Command m ()], World) m a)
  deriving ((forall a b. (a -> b) -> Task m s a -> Task m s b)
-> (forall a b. a -> Task m s b -> Task m s a)
-> Functor (Task m s)
forall a b. a -> Task m s b -> Task m s a
forall a b. (a -> b) -> Task m s a -> Task m s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) s a b.
Functor m =>
a -> Task m s b -> Task m s a
forall (m :: * -> *) s a b.
Functor m =>
(a -> b) -> Task m s a -> Task m s b
$cfmap :: forall (m :: * -> *) s a b.
Functor m =>
(a -> b) -> Task m s a -> Task m s b
fmap :: forall a b. (a -> b) -> Task m s a -> Task m s b
$c<$ :: forall (m :: * -> *) s a b.
Functor m =>
a -> Task m s b -> Task m s a
<$ :: forall a b. a -> Task m s b -> Task m s a
Functor, Functor (Task m s)
Functor (Task m s) =>
(forall a. a -> Task m s a)
-> (forall a b. Task m s (a -> b) -> Task m s a -> Task m s b)
-> (forall a b c.
    (a -> b -> c) -> Task m s a -> Task m s b -> Task m s c)
-> (forall a b. Task m s a -> Task m s b -> Task m s b)
-> (forall a b. Task m s a -> Task m s b -> Task m s a)
-> Applicative (Task m s)
forall a. a -> Task m s a
forall a b. Task m s a -> Task m s b -> Task m s a
forall a b. Task m s a -> Task m s b -> Task m s b
forall a b. Task m s (a -> b) -> Task m s a -> Task m s b
forall a b c.
(a -> b -> c) -> Task m s a -> Task m s b -> Task m s 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
forall (m :: * -> *) s. Monad m => Functor (Task m s)
forall (m :: * -> *) s a. Monad m => a -> Task m s a
forall (m :: * -> *) s a b.
Monad m =>
Task m s a -> Task m s b -> Task m s a
forall (m :: * -> *) s a b.
Monad m =>
Task m s a -> Task m s b -> Task m s b
forall (m :: * -> *) s a b.
Monad m =>
Task m s (a -> b) -> Task m s a -> Task m s b
forall (m :: * -> *) s a b c.
Monad m =>
(a -> b -> c) -> Task m s a -> Task m s b -> Task m s c
$cpure :: forall (m :: * -> *) s a. Monad m => a -> Task m s a
pure :: forall a. a -> Task m s a
$c<*> :: forall (m :: * -> *) s a b.
Monad m =>
Task m s (a -> b) -> Task m s a -> Task m s b
<*> :: forall a b. Task m s (a -> b) -> Task m s a -> Task m s b
$cliftA2 :: forall (m :: * -> *) s a b c.
Monad m =>
(a -> b -> c) -> Task m s a -> Task m s b -> Task m s c
liftA2 :: forall a b c.
(a -> b -> c) -> Task m s a -> Task m s b -> Task m s c
$c*> :: forall (m :: * -> *) s a b.
Monad m =>
Task m s a -> Task m s b -> Task m s b
*> :: forall a b. Task m s a -> Task m s b -> Task m s b
$c<* :: forall (m :: * -> *) s a b.
Monad m =>
Task m s a -> Task m s b -> Task m s a
<* :: forall a b. Task m s a -> Task m s b -> Task m s a
Applicative, Applicative (Task m s)
Applicative (Task m s) =>
(forall a b. Task m s a -> (a -> Task m s b) -> Task m s b)
-> (forall a b. Task m s a -> Task m s b -> Task m s b)
-> (forall a. a -> Task m s a)
-> Monad (Task m s)
forall a. a -> Task m s a
forall a b. Task m s a -> Task m s b -> Task m s b
forall a b. Task m s a -> (a -> Task m s b) -> Task m s 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
forall (m :: * -> *) s. Monad m => Applicative (Task m s)
forall (m :: * -> *) s a. Monad m => a -> Task m s a
forall (m :: * -> *) s a b.
Monad m =>
Task m s a -> Task m s b -> Task m s b
forall (m :: * -> *) s a b.
Monad m =>
Task m s a -> (a -> Task m s b) -> Task m s b
$c>>= :: forall (m :: * -> *) s a b.
Monad m =>
Task m s a -> (a -> Task m s b) -> Task m s b
>>= :: forall a b. Task m s a -> (a -> Task m s b) -> Task m s b
$c>> :: forall (m :: * -> *) s a b.
Monad m =>
Task m s a -> Task m s b -> Task m s b
>> :: forall a b. Task m s a -> Task m s b -> Task m s b
$creturn :: forall (m :: * -> *) s a. Monad m => a -> Task m s a
return :: forall a. a -> Task m s a
Monad, Monad (Task m s)
Monad (Task m s) =>
(forall a. IO a -> Task m s a) -> MonadIO (Task m s)
forall a. IO a -> Task m s a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *) s. MonadIO m => Monad (Task m s)
forall (m :: * -> *) s a. MonadIO m => IO a -> Task m s a
$cliftIO :: forall (m :: * -> *) s a. MonadIO m => IO a -> Task m s a
liftIO :: forall a. IO a -> Task m s a
MonadIO)

runTask :: (Functor m) => Task m s a -> s -> World -> m (a, s, [Command m ()], World)
runTask :: forall (m :: * -> *) s a.
Functor m =>
Task m s a -> s -> World -> m (a, s, [Command m ()], World)
runTask (Task StateT (s, [Command m ()], World) m a
t) s
s World
w = ((a, (s, [Command m ()], World)) -> (a, s, [Command m ()], World))
-> m (a, (s, [Command m ()], World))
-> m (a, s, [Command m ()], World)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
a, (s
s', [Command m ()]
cmds, World
w')) -> (a
a, s
s', [Command m ()]
cmds, World
w')) (StateT (s, [Command m ()], World) m a
-> (s, [Command m ()], World) -> m (a, (s, [Command m ()], World))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT (s, [Command m ()], World) m a
t (s
s, [], World
w))

-- | Queue a `Command` to run after this system is complete.
command :: (Monad m) => Command m () -> Task m a ()
command :: forall (m :: * -> *) a. Monad m => Command m () -> Task m a ()
command Command m ()
cmd = StateT (a, [Command m ()], World) m () -> Task m a ()
forall (m :: * -> *) s a.
StateT (s, [Command m ()], World) m a -> Task m s a
Task (StateT (a, [Command m ()], World) m () -> Task m a ())
-> StateT (a, [Command m ()], World) m () -> Task m a ()
forall a b. (a -> b) -> a -> b
$ do
  (a
s, [Command m ()]
cmds, World
w) <- StateT (a, [Command m ()], World) m (a, [Command m ()], World)
forall s (m :: * -> *). MonadState s m => m s
S.get
  (a, [Command m ()], World)
-> StateT (a, [Command m ()], World) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
S.put ((a, [Command m ()], World)
 -> StateT (a, [Command m ()], World) m ())
-> (a, [Command m ()], World)
-> StateT (a, [Command m ()], World) m ()
forall a b. (a -> b) -> a -> b
$ (a
s, [Command m ()]
cmds [Command m ()] -> [Command m ()] -> [Command m ()]
forall a. Semigroup a => a -> a -> a
<> [Command m ()
cmd], World
w)