{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RecursiveDo #-}

module Aztecs.ECS.Schedule.Dynamic
  ( DynamicSchedule,
    DynamicScheduleT (..),
    fromDynReaderSchedule,
  )
where

import Aztecs.ECS.Access
import Aztecs.ECS.Schedule.Dynamic.Reader (DynamicReaderScheduleT (..))
import Control.Arrow
import Control.Category
import Control.Monad.Fix
import Prelude hiding (id, (.))

type DynamicSchedule m = DynamicScheduleT (AccessT m)

newtype DynamicScheduleT m i o = DynamicSchedule {forall (m :: * -> *) i o.
DynamicScheduleT m i o -> i -> m (o, DynamicScheduleT m i o)
runScheduleDyn :: i -> m (o, DynamicScheduleT m i o)}
  deriving ((forall a b.
 (a -> b) -> DynamicScheduleT m i a -> DynamicScheduleT m i b)
-> (forall a b.
    a -> DynamicScheduleT m i b -> DynamicScheduleT m i a)
-> Functor (DynamicScheduleT m i)
forall a b. a -> DynamicScheduleT m i b -> DynamicScheduleT m i a
forall a b.
(a -> b) -> DynamicScheduleT m i a -> DynamicScheduleT 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 -> DynamicScheduleT m i b -> DynamicScheduleT m i a
forall (m :: * -> *) i a b.
Functor m =>
(a -> b) -> DynamicScheduleT m i a -> DynamicScheduleT m i b
$cfmap :: forall (m :: * -> *) i a b.
Functor m =>
(a -> b) -> DynamicScheduleT m i a -> DynamicScheduleT m i b
fmap :: forall a b.
(a -> b) -> DynamicScheduleT m i a -> DynamicScheduleT m i b
$c<$ :: forall (m :: * -> *) i a b.
Functor m =>
a -> DynamicScheduleT m i b -> DynamicScheduleT m i a
<$ :: forall a b. a -> DynamicScheduleT m i b -> DynamicScheduleT m i a
Functor)

instance (Monad m) => Category (DynamicScheduleT m) where
  id :: forall a. DynamicScheduleT m a a
id = (a -> m (a, DynamicScheduleT m a a)) -> DynamicScheduleT m a a
forall (m :: * -> *) i o.
(i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o
DynamicSchedule ((a -> m (a, DynamicScheduleT m a a)) -> DynamicScheduleT m a a)
-> (a -> m (a, DynamicScheduleT m a a)) -> DynamicScheduleT m a a
forall a b. (a -> b) -> a -> b
$ \a
i -> (a, DynamicScheduleT m a a) -> m (a, DynamicScheduleT m a a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
i, DynamicScheduleT m a a
forall a. DynamicScheduleT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
  DynamicSchedule b -> m (c, DynamicScheduleT m b c)
f . :: forall b c a.
DynamicScheduleT m b c
-> DynamicScheduleT m a b -> DynamicScheduleT m a c
. DynamicSchedule a -> m (b, DynamicScheduleT m a b)
g = (a -> m (c, DynamicScheduleT m a c)) -> DynamicScheduleT m a c
forall (m :: * -> *) i o.
(i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o
DynamicSchedule ((a -> m (c, DynamicScheduleT m a c)) -> DynamicScheduleT m a c)
-> (a -> m (c, DynamicScheduleT m a c)) -> DynamicScheduleT m a c
forall a b. (a -> b) -> a -> b
$ \a
i -> do
    (b
b, DynamicScheduleT m a b
g') <- a -> m (b, DynamicScheduleT m a b)
g a
i
    (c
c, DynamicScheduleT m b c
f') <- b -> m (c, DynamicScheduleT m b c)
f b
b
    (c, DynamicScheduleT m a c) -> m (c, DynamicScheduleT m a c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, DynamicScheduleT m b c
f' DynamicScheduleT m b c
-> DynamicScheduleT m a b -> DynamicScheduleT m a c
forall b c a.
DynamicScheduleT m b c
-> DynamicScheduleT m a b -> DynamicScheduleT m a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DynamicScheduleT m a b
g')

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

instance (Monad m) => ArrowChoice (DynamicScheduleT m) where
  left :: forall b c d.
DynamicScheduleT m b c
-> DynamicScheduleT m (Either b d) (Either c d)
left (DynamicSchedule b -> m (c, DynamicScheduleT m b c)
f) = (Either b d
 -> m (Either c d, DynamicScheduleT m (Either b d) (Either c d)))
-> DynamicScheduleT m (Either b d) (Either c d)
forall (m :: * -> *) i o.
(i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o
DynamicSchedule ((Either b d
  -> m (Either c d, DynamicScheduleT m (Either b d) (Either c d)))
 -> DynamicScheduleT m (Either b d) (Either c d))
-> (Either b d
    -> m (Either c d, DynamicScheduleT m (Either b d) (Either c d)))
-> DynamicScheduleT m (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$ \Either b d
i -> case Either b d
i of
    Left b
b -> do
      (c
c, DynamicScheduleT m b c
f') <- b -> m (c, DynamicScheduleT m b c)
f b
b
      (Either c d, DynamicScheduleT m (Either b d) (Either c d))
-> m (Either c d, DynamicScheduleT m (Either b d) (Either c d))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Either c d
forall a b. a -> Either a b
Left c
c, DynamicScheduleT m b c
-> DynamicScheduleT m (Either b d) (Either c d)
forall b c d.
DynamicScheduleT m b c
-> DynamicScheduleT m (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left DynamicScheduleT m b c
f')
    Right d
d -> (Either c d, DynamicScheduleT m (Either b d) (Either c d))
-> m (Either c d, DynamicScheduleT m (Either b d) (Either c d))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> Either c d
forall a b. b -> Either a b
Right d
d, DynamicScheduleT m b c
-> DynamicScheduleT m (Either b d) (Either c d)
forall b c d.
DynamicScheduleT m b c
-> DynamicScheduleT m (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ((b -> m (c, DynamicScheduleT m b c)) -> DynamicScheduleT m b c
forall (m :: * -> *) i o.
(i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o
DynamicSchedule b -> m (c, DynamicScheduleT m b c)
f))

instance (MonadFix m) => ArrowLoop (DynamicScheduleT m) where
  loop :: forall b d c.
DynamicScheduleT m (b, d) (c, d) -> DynamicScheduleT m b c
loop (DynamicSchedule (b, d) -> m ((c, d), DynamicScheduleT m (b, d) (c, d))
f) = (b -> m (c, DynamicScheduleT m b c)) -> DynamicScheduleT m b c
forall (m :: * -> *) i o.
(i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o
DynamicSchedule ((b -> m (c, DynamicScheduleT m b c)) -> DynamicScheduleT m b c)
-> (b -> m (c, DynamicScheduleT m b c)) -> DynamicScheduleT m b c
forall a b. (a -> b) -> a -> b
$ \b
b -> do
    rec ((c
c, d
d), DynamicScheduleT m (b, d) (c, d)
f') <- (b, d) -> m ((c, d), DynamicScheduleT m (b, d) (c, d))
f (b
b, d
d)
    (c, DynamicScheduleT m b c) -> m (c, DynamicScheduleT m b c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, DynamicScheduleT m (b, d) (c, d) -> DynamicScheduleT m b c
forall b d c.
DynamicScheduleT m (b, d) (c, d) -> DynamicScheduleT m b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop DynamicScheduleT m (b, d) (c, d)
f')

fromDynReaderSchedule :: (Monad m) => DynamicReaderScheduleT m i o -> DynamicScheduleT m i o
fromDynReaderSchedule :: forall (m :: * -> *) i o.
Monad m =>
DynamicReaderScheduleT m i o -> DynamicScheduleT m i o
fromDynReaderSchedule (DynamicReaderSchedule i -> m (o, DynamicReaderScheduleT m i o)
f) = (i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o
forall (m :: * -> *) i o.
(i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o
DynamicSchedule ((i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o)
-> (i -> m (o, DynamicScheduleT m i o)) -> DynamicScheduleT m i o
forall a b. (a -> b) -> a -> b
$ \i
i -> do
  (o
o, DynamicReaderScheduleT m i o
f') <- i -> m (o, DynamicReaderScheduleT m i o)
f i
i
  (o, DynamicScheduleT m i o) -> m (o, DynamicScheduleT m i o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (o
o, DynamicReaderScheduleT m i o -> DynamicScheduleT m i o
forall (m :: * -> *) i o.
Monad m =>
DynamicReaderScheduleT m i o -> DynamicScheduleT m i o
fromDynReaderSchedule DynamicReaderScheduleT m i o
f')