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

module Aztecs.ECS.Schedule.Reader
  ( ReaderScheduleT (..),
  )
where

import Aztecs.ECS.Access
import Aztecs.ECS.Schedule.Dynamic.Reader
import Aztecs.ECS.Schedule.Reader.Class
import Aztecs.ECS.System.Dynamic.Reader
import Aztecs.ECS.System.Reader
import Aztecs.ECS.World (World (..))
import Aztecs.ECS.World.Components (Components)
import Control.Arrow
import Control.Category
import Control.Monad.Fix
import Control.Monad.State (MonadState (..))
import Control.Monad.Trans
import Prelude hiding (id, (.))

type ReaderSchedule m = ReaderScheduleT (AccessT m)

newtype ReaderScheduleT m i o
  = ReaderSchedule {forall (m :: * -> *) i o.
ReaderScheduleT m i o
-> Components -> (DynamicReaderScheduleT m i o, Components)
runReaderSchedule :: Components -> (DynamicReaderScheduleT m i o, Components)}
  deriving ((forall a b.
 (a -> b) -> ReaderScheduleT m i a -> ReaderScheduleT m i b)
-> (forall a b.
    a -> ReaderScheduleT m i b -> ReaderScheduleT m i a)
-> Functor (ReaderScheduleT m i)
forall a b. a -> ReaderScheduleT m i b -> ReaderScheduleT m i a
forall a b.
(a -> b) -> ReaderScheduleT m i a -> ReaderScheduleT 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 -> ReaderScheduleT m i b -> ReaderScheduleT m i a
forall (m :: * -> *) i a b.
Functor m =>
(a -> b) -> ReaderScheduleT m i a -> ReaderScheduleT m i b
$cfmap :: forall (m :: * -> *) i a b.
Functor m =>
(a -> b) -> ReaderScheduleT m i a -> ReaderScheduleT m i b
fmap :: forall a b.
(a -> b) -> ReaderScheduleT m i a -> ReaderScheduleT m i b
$c<$ :: forall (m :: * -> *) i a b.
Functor m =>
a -> ReaderScheduleT m i b -> ReaderScheduleT m i a
<$ :: forall a b. a -> ReaderScheduleT m i b -> ReaderScheduleT m i a
Functor)

instance (Monad m) => Category (ReaderScheduleT m) where
  id :: forall a. ReaderScheduleT m a a
id = (Components -> (DynamicReaderScheduleT m a a, Components))
-> ReaderScheduleT m a a
forall (m :: * -> *) i o.
(Components -> (DynamicReaderScheduleT m i o, Components))
-> ReaderScheduleT m i o
ReaderSchedule ((Components -> (DynamicReaderScheduleT m a a, Components))
 -> ReaderScheduleT m a a)
-> (Components -> (DynamicReaderScheduleT m a a, Components))
-> ReaderScheduleT m a a
forall a b. (a -> b) -> a -> b
$ \Components
cs -> (DynamicReaderScheduleT m a a
forall a. DynamicReaderScheduleT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, Components
cs)
  ReaderSchedule Components -> (DynamicReaderScheduleT m b c, Components)
f . :: forall b c a.
ReaderScheduleT m b c
-> ReaderScheduleT m a b -> ReaderScheduleT m a c
. ReaderSchedule Components -> (DynamicReaderScheduleT m a b, Components)
g = (Components -> (DynamicReaderScheduleT m a c, Components))
-> ReaderScheduleT m a c
forall (m :: * -> *) i o.
(Components -> (DynamicReaderScheduleT m i o, Components))
-> ReaderScheduleT m i o
ReaderSchedule ((Components -> (DynamicReaderScheduleT m a c, Components))
 -> ReaderScheduleT m a c)
-> (Components -> (DynamicReaderScheduleT m a c, Components))
-> ReaderScheduleT m a c
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let (DynamicReaderScheduleT m a b
g', Components
cs') = Components -> (DynamicReaderScheduleT m a b, Components)
g Components
cs
        (DynamicReaderScheduleT m b c
f', Components
cs'') = Components -> (DynamicReaderScheduleT m b c, Components)
f Components
cs'
     in (DynamicReaderScheduleT m b c
f' DynamicReaderScheduleT m b c
-> DynamicReaderScheduleT m a b -> DynamicReaderScheduleT m a c
forall b c a.
DynamicReaderScheduleT m b c
-> DynamicReaderScheduleT m a b -> DynamicReaderScheduleT 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
. DynamicReaderScheduleT m a b
g', Components
cs'')

instance (Monad m) => Arrow (ReaderScheduleT m) where
  arr :: forall b c. (b -> c) -> ReaderScheduleT m b c
arr b -> c
f = (Components -> (DynamicReaderScheduleT m b c, Components))
-> ReaderScheduleT m b c
forall (m :: * -> *) i o.
(Components -> (DynamicReaderScheduleT m i o, Components))
-> ReaderScheduleT m i o
ReaderSchedule ((Components -> (DynamicReaderScheduleT m b c, Components))
 -> ReaderScheduleT m b c)
-> (Components -> (DynamicReaderScheduleT m b c, Components))
-> ReaderScheduleT m b c
forall a b. (a -> b) -> a -> b
$ \Components
cs -> ((b -> c) -> DynamicReaderScheduleT m b c
forall b c. (b -> c) -> DynamicReaderScheduleT m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f, Components
cs)
  first :: forall b c d.
ReaderScheduleT m b c -> ReaderScheduleT m (b, d) (c, d)
first (ReaderSchedule Components -> (DynamicReaderScheduleT m b c, Components)
f) = (Components
 -> (DynamicReaderScheduleT m (b, d) (c, d), Components))
-> ReaderScheduleT m (b, d) (c, d)
forall (m :: * -> *) i o.
(Components -> (DynamicReaderScheduleT m i o, Components))
-> ReaderScheduleT m i o
ReaderSchedule ((Components
  -> (DynamicReaderScheduleT m (b, d) (c, d), Components))
 -> ReaderScheduleT m (b, d) (c, d))
-> (Components
    -> (DynamicReaderScheduleT m (b, d) (c, d), Components))
-> ReaderScheduleT m (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \Components
cs -> let (DynamicReaderScheduleT m b c
f', Components
cs') = Components -> (DynamicReaderScheduleT m b c, Components)
f Components
cs in (DynamicReaderScheduleT m b c
-> DynamicReaderScheduleT m (b, d) (c, d)
forall b c d.
DynamicReaderScheduleT m b c
-> DynamicReaderScheduleT m (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first DynamicReaderScheduleT m b c
f', Components
cs')

instance (Monad m) => ArrowChoice (ReaderScheduleT m) where
  left :: forall b c d.
ReaderScheduleT m b c
-> ReaderScheduleT m (Either b d) (Either c d)
left (ReaderSchedule Components -> (DynamicReaderScheduleT m b c, Components)
f) = (Components
 -> (DynamicReaderScheduleT m (Either b d) (Either c d),
     Components))
-> ReaderScheduleT m (Either b d) (Either c d)
forall (m :: * -> *) i o.
(Components -> (DynamicReaderScheduleT m i o, Components))
-> ReaderScheduleT m i o
ReaderSchedule ((Components
  -> (DynamicReaderScheduleT m (Either b d) (Either c d),
      Components))
 -> ReaderScheduleT m (Either b d) (Either c d))
-> (Components
    -> (DynamicReaderScheduleT m (Either b d) (Either c d),
        Components))
-> ReaderScheduleT m (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$ \Components
cs -> let (DynamicReaderScheduleT m b c
f', Components
cs') = Components -> (DynamicReaderScheduleT m b c, Components)
f Components
cs in (DynamicReaderScheduleT m b c
-> DynamicReaderScheduleT m (Either b d) (Either c d)
forall b c d.
DynamicReaderScheduleT m b c
-> DynamicReaderScheduleT 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 DynamicReaderScheduleT m b c
f', Components
cs')

instance (MonadFix m) => ArrowLoop (ReaderScheduleT m) where
  loop :: forall b d c.
ReaderScheduleT m (b, d) (c, d) -> ReaderScheduleT m b c
loop (ReaderSchedule Components -> (DynamicReaderScheduleT m (b, d) (c, d), Components)
f) = (Components -> (DynamicReaderScheduleT m b c, Components))
-> ReaderScheduleT m b c
forall (m :: * -> *) i o.
(Components -> (DynamicReaderScheduleT m i o, Components))
-> ReaderScheduleT m i o
ReaderSchedule ((Components -> (DynamicReaderScheduleT m b c, Components))
 -> ReaderScheduleT m b c)
-> (Components -> (DynamicReaderScheduleT m b c, Components))
-> ReaderScheduleT m b c
forall a b. (a -> b) -> a -> b
$ \Components
cs -> let (DynamicReaderScheduleT m (b, d) (c, d)
f', Components
cs') = Components -> (DynamicReaderScheduleT m (b, d) (c, d), Components)
f Components
cs in (DynamicReaderScheduleT m (b, d) (c, d)
-> DynamicReaderScheduleT m b c
forall b d c.
DynamicReaderScheduleT m (b, d) (c, d)
-> DynamicReaderScheduleT m b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop DynamicReaderScheduleT m (b, d) (c, d)
f', Components
cs')

instance (Monad m) => ArrowReaderSchedule (ReaderSystemT m) (ReaderSchedule m) where
  reader :: forall i o. ReaderSystemT m i o -> ReaderSchedule m i o
reader ReaderSystemT m i o
s = (Components
 -> (DynamicReaderScheduleT (AccessT m) i o, Components))
-> ReaderScheduleT (AccessT m) i o
forall (m :: * -> *) i o.
(Components -> (DynamicReaderScheduleT m i o, Components))
-> ReaderScheduleT m i o
ReaderSchedule ((Components
  -> (DynamicReaderScheduleT (AccessT m) i o, Components))
 -> ReaderScheduleT (AccessT m) i o)
-> (Components
    -> (DynamicReaderScheduleT (AccessT m) i o, Components))
-> ReaderScheduleT (AccessT m) i o
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let (DynamicReaderSystemT m i o
dynS, Set ComponentID
_, Components
cs') = ReaderSystemT m i o
-> Components
-> (DynamicReaderSystemT m i o, Set ComponentID, Components)
forall (m :: * -> *) i o.
ReaderSystemT m i o
-> Components
-> (DynamicReaderSystemT m i o, Set ComponentID, Components)
runReaderSystem ReaderSystemT m i o
s Components
cs
        go :: DynamicReaderSystemT m i o
-> i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o)
go DynamicReaderSystemT m i o
dynSAcc i
i = StateT World m (o, DynamicReaderScheduleT (AccessT m) i o)
-> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o)
forall (m :: * -> *) a. StateT World m a -> AccessT m a
AccessT (StateT World m (o, DynamicReaderScheduleT (AccessT m) i o)
 -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o))
-> StateT World m (o, DynamicReaderScheduleT (AccessT m) i o)
-> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o)
forall a b. (a -> b) -> a -> b
$ do
          World
w <- StateT World m World
forall s (m :: * -> *). MonadState s m => m s
get
          let (o
o, AccessT m ()
a, DynamicReaderSystemT m i o
dynSAcc') = DynamicReaderSystemT m i o
-> Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o)
forall (m :: * -> *) i o.
DynamicReaderSystemT m i o
-> Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o)
runReaderSystemDyn DynamicReaderSystemT m i o
dynSAcc (World -> Entities
entities World
w) i
i
          ((), World
w') <- m ((), World) -> StateT World m ((), World)
forall (m :: * -> *) a. Monad m => m a -> StateT World m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ((), World) -> StateT World m ((), World))
-> m ((), World) -> StateT World m ((), World)
forall a b. (a -> b) -> a -> b
$ AccessT m () -> World -> m ((), World)
forall (m :: * -> *) a.
Functor m =>
AccessT m a -> World -> m (a, World)
runAccessT AccessT m ()
a World
w
          World -> StateT World m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put World
w'
          (o, DynamicReaderScheduleT (AccessT m) i o)
-> StateT World m (o, DynamicReaderScheduleT (AccessT m) i o)
forall a. a -> StateT World m a
forall (m :: * -> *) a. Monad m => a -> m a
return (o
o, (i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o))
-> DynamicReaderScheduleT (AccessT m) i o
forall (m :: * -> *) i o.
(i -> m (o, DynamicReaderScheduleT m i o))
-> DynamicReaderScheduleT m i o
DynamicReaderSchedule ((i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o))
 -> DynamicReaderScheduleT (AccessT m) i o)
-> (i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o))
-> DynamicReaderScheduleT (AccessT m) i o
forall a b. (a -> b) -> a -> b
$ DynamicReaderSystemT m i o
-> i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o)
go DynamicReaderSystemT m i o
dynSAcc')
     in ((i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o))
-> DynamicReaderScheduleT (AccessT m) i o
forall (m :: * -> *) i o.
(i -> m (o, DynamicReaderScheduleT m i o))
-> DynamicReaderScheduleT m i o
DynamicReaderSchedule ((i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o))
 -> DynamicReaderScheduleT (AccessT m) i o)
-> (i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o))
-> DynamicReaderScheduleT (AccessT m) i o
forall a b. (a -> b) -> a -> b
$ DynamicReaderSystemT m i o
-> i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o)
forall {m :: * -> *} {i} {o}.
Monad m =>
DynamicReaderSystemT m i o
-> i -> AccessT m (o, DynamicReaderScheduleT (AccessT m) i o)
go DynamicReaderSystemT m i o
dynS, Components
cs')