{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Aztecs.ECS.Schedule.Access (AcessSchedule (..), ArrowAccessSchedule (..)) where

import Aztecs.ECS.Access (AccessT (..))
import Aztecs.ECS.Schedule (ArrowAccessSchedule (..))
import Aztecs.ECS.World.Bundle (Bundle)
import Control.Arrow (Arrow (..))
import Control.Category (Category (..))
import Control.Monad ((>=>))

newtype AcessSchedule m i o = AcessSchedule {forall (m :: * -> *) i o. AcessSchedule m i o -> i -> AccessT m o
runAcessSchedule :: i -> AccessT m o}
  deriving ((forall a b.
 (a -> b) -> AcessSchedule m i a -> AcessSchedule m i b)
-> (forall a b. a -> AcessSchedule m i b -> AcessSchedule m i a)
-> Functor (AcessSchedule m i)
forall a b. a -> AcessSchedule m i b -> AcessSchedule m i a
forall a b. (a -> b) -> AcessSchedule m i a -> AcessSchedule m i b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) i a b.
Functor m =>
a -> AcessSchedule m i b -> AcessSchedule m i a
forall (m :: * -> *) i a b.
Functor m =>
(a -> b) -> AcessSchedule m i a -> AcessSchedule m i b
$cfmap :: forall (m :: * -> *) i a b.
Functor m =>
(a -> b) -> AcessSchedule m i a -> AcessSchedule m i b
fmap :: forall a b. (a -> b) -> AcessSchedule m i a -> AcessSchedule m i b
$c<$ :: forall (m :: * -> *) i a b.
Functor m =>
a -> AcessSchedule m i b -> AcessSchedule m i a
<$ :: forall a b. a -> AcessSchedule m i b -> AcessSchedule m i a
Functor)

instance (Monad m) => Category (AcessSchedule m) where
  id :: forall a. AcessSchedule m a a
id = (a -> AccessT m a) -> AcessSchedule m a a
forall (m :: * -> *) i o. (i -> AccessT m o) -> AcessSchedule m i o
AcessSchedule a -> AccessT m a
forall a. a -> AccessT m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  AcessSchedule b -> AccessT m c
f . :: forall b c a.
AcessSchedule m b c -> AcessSchedule m a b -> AcessSchedule m a c
. AcessSchedule a -> AccessT m b
g = (a -> AccessT m c) -> AcessSchedule m a c
forall (m :: * -> *) i o. (i -> AccessT m o) -> AcessSchedule m i o
AcessSchedule (a -> AccessT m b
g (a -> AccessT m b) -> (b -> AccessT m c) -> a -> AccessT m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> AccessT m c
f)

instance (Monad m) => Arrow (AcessSchedule m) where
  arr :: forall b c. (b -> c) -> AcessSchedule m b c
arr b -> c
f = (b -> AccessT m c) -> AcessSchedule m b c
forall (m :: * -> *) i o. (i -> AccessT m o) -> AcessSchedule m i o
AcessSchedule ((b -> AccessT m c) -> AcessSchedule m b c)
-> (b -> AccessT m c) -> AcessSchedule m b c
forall a b. (a -> b) -> a -> b
$ \b
i -> c -> AccessT m c
forall a. a -> AccessT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> AccessT m c) -> c -> AccessT m c
forall a b. (a -> b) -> a -> b
$ b -> c
f b
i
  first :: forall b c d. AcessSchedule m b c -> AcessSchedule m (b, d) (c, d)
first (AcessSchedule b -> AccessT m c
f) = ((b, d) -> AccessT m (c, d)) -> AcessSchedule m (b, d) (c, d)
forall (m :: * -> *) i o. (i -> AccessT m o) -> AcessSchedule m i o
AcessSchedule (((b, d) -> AccessT m (c, d)) -> AcessSchedule m (b, d) (c, d))
-> ((b, d) -> AccessT m (c, d)) -> AcessSchedule m (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \(b
b, d
d) -> do
    c
c <- b -> AccessT m c
f b
b
    (c, d) -> AccessT m (c, d)
forall a. a -> AccessT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, d
d)

instance (Monad m) => ArrowAccessSchedule Bundle (AccessT m) (AcessSchedule m) where
  access :: forall i o. (i -> AccessT m o) -> AcessSchedule m i o
access = (i -> AccessT m o) -> AcessSchedule m i o
forall (m :: * -> *) i o. (i -> AccessT m o) -> AcessSchedule m i o
AcessSchedule