{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Aztecs.ECS.System.Queue (QueueSystem (..), ArrowQueueSystem (..)) where

import Aztecs.ECS.Access (Access)
import Aztecs.ECS.System.Queue.Class (ArrowQueueSystem (..))
import Aztecs.ECS.World.Bundle (Bundle)
import Control.Arrow (Arrow (..))
import Control.Category (Category (..))

-- | System that can queue `Access` to a `World`.
newtype QueueSystem i o = QueueSystem {forall i o. QueueSystem i o -> i -> (o, Access ())
runQueueSystem :: i -> (o, Access ())}
  deriving ((forall a b. (a -> b) -> QueueSystem i a -> QueueSystem i b)
-> (forall a b. a -> QueueSystem i b -> QueueSystem i a)
-> Functor (QueueSystem i)
forall a b. a -> QueueSystem i b -> QueueSystem i a
forall a b. (a -> b) -> QueueSystem i a -> QueueSystem i b
forall i a b. a -> QueueSystem i b -> QueueSystem i a
forall i a b. (a -> b) -> QueueSystem i a -> QueueSystem i b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall i a b. (a -> b) -> QueueSystem i a -> QueueSystem i b
fmap :: forall a b. (a -> b) -> QueueSystem i a -> QueueSystem i b
$c<$ :: forall i a b. a -> QueueSystem i b -> QueueSystem i a
<$ :: forall a b. a -> QueueSystem i b -> QueueSystem i a
Functor)

instance Category QueueSystem where
  id :: forall a. QueueSystem a a
id = (a -> (a, Access ())) -> QueueSystem a a
forall i o. (i -> (o, Access ())) -> QueueSystem i o
QueueSystem ((a -> (a, Access ())) -> QueueSystem a a)
-> (a -> (a, Access ())) -> QueueSystem a a
forall a b. (a -> b) -> a -> b
$ \a
i -> (a
i, () -> Access ()
forall a. a -> AccessT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  QueueSystem b -> (c, Access ())
f . :: forall b c a. QueueSystem b c -> QueueSystem a b -> QueueSystem a c
. QueueSystem a -> (b, Access ())
g = (a -> (c, Access ())) -> QueueSystem a c
forall i o. (i -> (o, Access ())) -> QueueSystem i o
QueueSystem ((a -> (c, Access ())) -> QueueSystem a c)
-> (a -> (c, Access ())) -> QueueSystem a c
forall a b. (a -> b) -> a -> b
$ \a
i ->
    let (b
b, Access ()
access) = a -> (b, Access ())
g a
i
        (c
c, Access ()
access') = b -> (c, Access ())
f b
b
     in (c
c, Access ()
access Access () -> Access () -> Access ()
forall a b.
AccessT Identity a -> AccessT Identity b -> AccessT Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Access ()
access')

instance Arrow QueueSystem where
  arr :: forall b c. (b -> c) -> QueueSystem b c
arr b -> c
f = (b -> (c, Access ())) -> QueueSystem b c
forall i o. (i -> (o, Access ())) -> QueueSystem i o
QueueSystem ((b -> (c, Access ())) -> QueueSystem b c)
-> (b -> (c, Access ())) -> QueueSystem b c
forall a b. (a -> b) -> a -> b
$ \b
i -> (b -> c
f b
i, () -> Access ()
forall a. a -> AccessT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  first :: forall b c d. QueueSystem b c -> QueueSystem (b, d) (c, d)
first (QueueSystem b -> (c, Access ())
f) = ((b, d) -> ((c, d), Access ())) -> QueueSystem (b, d) (c, d)
forall i o. (i -> (o, Access ())) -> QueueSystem i o
QueueSystem (((b, d) -> ((c, d), Access ())) -> QueueSystem (b, d) (c, d))
-> ((b, d) -> ((c, d), Access ())) -> QueueSystem (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \(b
b, d
d) ->
    let (c
c, Access ()
access) = b -> (c, Access ())
f b
b in ((c
c, d
d), Access ()
access)

instance ArrowQueueSystem Bundle Access QueueSystem where
  queue :: forall i. (i -> Access ()) -> QueueSystem i ()
queue i -> Access ()
f = (i -> ((), Access ())) -> QueueSystem i ()
forall i o. (i -> (o, Access ())) -> QueueSystem i o
QueueSystem ((i -> ((), Access ())) -> QueueSystem i ())
-> (i -> ((), Access ())) -> QueueSystem i ()
forall a b. (a -> b) -> a -> b
$ \i
i -> let !a :: Access ()
a = i -> Access ()
f i
i in ((), Access ()
a)