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

module Aztecs.ECS.System.Dynamic.Reader
  ( DynamicReaderSystem,
    DynamicReaderSystemT (..),
    ArrowDynamicReaderSystem (..),
    ArrowQueueSystem (..),
    raceDyn,
  )
where

import Aztecs.ECS.Access
import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReader (..), runDynQueryReader)
import Aztecs.ECS.System.Dynamic.Reader.Class
import Aztecs.ECS.System.Queue (ArrowQueueSystem (..))
import qualified Aztecs.ECS.View as V
import qualified Aztecs.ECS.World.Archetype as A
import Aztecs.ECS.World.Bundle
import Aztecs.ECS.World.Entities (Entities (..))
import Control.Arrow
import Control.Category
import Control.Monad.Identity
import Control.Parallel (par)
import qualified Data.Map as Map
import Prelude hiding (id, (.))

type DynamicReaderSystem = DynamicReaderSystemT Identity

newtype DynamicReaderSystemT m i o = DynamicReaderSystem
  { -- | Run a dynamic system producing some output
    forall (m :: * -> *) i o.
DynamicReaderSystemT m i o
-> Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o)
runReaderSystemDyn :: Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o)
  }
  deriving ((forall a b.
 (a -> b)
 -> DynamicReaderSystemT m i a -> DynamicReaderSystemT m i b)
-> (forall a b.
    a -> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i a)
-> Functor (DynamicReaderSystemT m i)
forall a b.
a -> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i a
forall a b.
(a -> b)
-> DynamicReaderSystemT m i a -> DynamicReaderSystemT 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.
a -> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i a
forall (m :: * -> *) i a b.
(a -> b)
-> DynamicReaderSystemT m i a -> DynamicReaderSystemT m i b
$cfmap :: forall (m :: * -> *) i a b.
(a -> b)
-> DynamicReaderSystemT m i a -> DynamicReaderSystemT m i b
fmap :: forall a b.
(a -> b)
-> DynamicReaderSystemT m i a -> DynamicReaderSystemT m i b
$c<$ :: forall (m :: * -> *) i a b.
a -> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i a
<$ :: forall a b.
a -> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i a
Functor)

instance (Monad m) => Category (DynamicReaderSystemT m) where
  id :: forall a. DynamicReaderSystemT m a a
id = (Entities -> a -> (a, AccessT m (), DynamicReaderSystemT m a a))
-> DynamicReaderSystemT m a a
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities -> a -> (a, AccessT m (), DynamicReaderSystemT m a a))
 -> DynamicReaderSystemT m a a)
-> (Entities -> a -> (a, AccessT m (), DynamicReaderSystemT m a a))
-> DynamicReaderSystemT m a a
forall a b. (a -> b) -> a -> b
$ \Entities
_ a
i -> (a
i, () -> AccessT m ()
forall a. a -> AccessT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), DynamicReaderSystemT m a a
forall a. DynamicReaderSystemT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
  DynamicReaderSystem Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c)
f . :: forall b c a.
DynamicReaderSystemT m b c
-> DynamicReaderSystemT m a b -> DynamicReaderSystemT m a c
. DynamicReaderSystem Entities -> a -> (b, AccessT m (), DynamicReaderSystemT m a b)
g = (Entities -> a -> (c, AccessT m (), DynamicReaderSystemT m a c))
-> DynamicReaderSystemT m a c
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities -> a -> (c, AccessT m (), DynamicReaderSystemT m a c))
 -> DynamicReaderSystemT m a c)
-> (Entities -> a -> (c, AccessT m (), DynamicReaderSystemT m a c))
-> DynamicReaderSystemT m a c
forall a b. (a -> b) -> a -> b
$ \Entities
w a
i ->
    let (b
b, AccessT m ()
gAccess, DynamicReaderSystemT m a b
g') = Entities -> a -> (b, AccessT m (), DynamicReaderSystemT m a b)
g Entities
w a
i
        (c
c, AccessT m ()
fAccess, DynamicReaderSystemT m b c
f') = Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c)
f Entities
w b
b
     in (c
c, AccessT m ()
gAccess AccessT m () -> AccessT m () -> AccessT m ()
forall a b. AccessT m a -> AccessT m b -> AccessT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AccessT m ()
fAccess, DynamicReaderSystemT m b c
f' DynamicReaderSystemT m b c
-> DynamicReaderSystemT m a b -> DynamicReaderSystemT m a c
forall b c a.
DynamicReaderSystemT m b c
-> DynamicReaderSystemT m a b -> DynamicReaderSystemT 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
. DynamicReaderSystemT m a b
g')

instance (Monad m) => Arrow (DynamicReaderSystemT m) where
  arr :: forall b c. (b -> c) -> DynamicReaderSystemT m b c
arr b -> c
f = (Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c))
-> DynamicReaderSystemT m b c
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c))
 -> DynamicReaderSystemT m b c)
-> (Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c))
-> DynamicReaderSystemT m b c
forall a b. (a -> b) -> a -> b
$ \Entities
_ b
i -> (b -> c
f b
i, () -> AccessT m ()
forall a. a -> AccessT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), (b -> c) -> DynamicReaderSystemT m b c
forall b c. (b -> c) -> DynamicReaderSystemT m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f)
  first :: forall b c d.
DynamicReaderSystemT m b c -> DynamicReaderSystemT m (b, d) (c, d)
first (DynamicReaderSystem Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c)
f) = (Entities
 -> (b, d)
 -> ((c, d), AccessT m (), DynamicReaderSystemT m (b, d) (c, d)))
-> DynamicReaderSystemT m (b, d) (c, d)
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities
  -> (b, d)
  -> ((c, d), AccessT m (), DynamicReaderSystemT m (b, d) (c, d)))
 -> DynamicReaderSystemT m (b, d) (c, d))
-> (Entities
    -> (b, d)
    -> ((c, d), AccessT m (), DynamicReaderSystemT m (b, d) (c, d)))
-> DynamicReaderSystemT m (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \Entities
w (b
i, d
x) ->
    let (c
a, AccessT m ()
access, DynamicReaderSystemT m b c
f') = Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c)
f Entities
w b
i in ((c
a, d
x), AccessT m ()
access, DynamicReaderSystemT m b c -> DynamicReaderSystemT m (b, d) (c, d)
forall b c d.
DynamicReaderSystemT m b c -> DynamicReaderSystemT m (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first DynamicReaderSystemT m b c
f')

instance (Monad m) => ArrowChoice (DynamicReaderSystemT m) where
  left :: forall b c d.
DynamicReaderSystemT m b c
-> DynamicReaderSystemT m (Either b d) (Either c d)
left (DynamicReaderSystem Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c)
f) = (Entities
 -> Either b d
 -> (Either c d, AccessT m (),
     DynamicReaderSystemT m (Either b d) (Either c d)))
-> DynamicReaderSystemT m (Either b d) (Either c d)
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities
  -> Either b d
  -> (Either c d, AccessT m (),
      DynamicReaderSystemT m (Either b d) (Either c d)))
 -> DynamicReaderSystemT m (Either b d) (Either c d))
-> (Entities
    -> Either b d
    -> (Either c d, AccessT m (),
        DynamicReaderSystemT m (Either b d) (Either c d)))
-> DynamicReaderSystemT m (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$ \Entities
w Either b d
i -> case Either b d
i of
    Left b
b -> let (c
c, AccessT m ()
access, DynamicReaderSystemT m b c
f') = Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c)
f Entities
w b
b in (c -> Either c d
forall a b. a -> Either a b
Left c
c, AccessT m ()
access, DynamicReaderSystemT m b c
-> DynamicReaderSystemT m (Either b d) (Either c d)
forall b c d.
DynamicReaderSystemT m b c
-> DynamicReaderSystemT 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 DynamicReaderSystemT m b c
f')
    Right d
d -> (d -> Either c d
forall a b. b -> Either a b
Right d
d, () -> AccessT m ()
forall a. a -> AccessT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), DynamicReaderSystemT m b c
-> DynamicReaderSystemT m (Either b d) (Either c d)
forall b c d.
DynamicReaderSystemT m b c
-> DynamicReaderSystemT 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 ((Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c))
-> DynamicReaderSystemT m b c
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c)
f))

instance (Monad m) => ArrowLoop (DynamicReaderSystemT m) where
  loop :: forall b d c.
DynamicReaderSystemT m (b, d) (c, d) -> DynamicReaderSystemT m b c
loop (DynamicReaderSystem Entities
-> (b, d)
-> ((c, d), AccessT m (), DynamicReaderSystemT m (b, d) (c, d))
f) = (Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c))
-> DynamicReaderSystemT m b c
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c))
 -> DynamicReaderSystemT m b c)
-> (Entities -> b -> (c, AccessT m (), DynamicReaderSystemT m b c))
-> DynamicReaderSystemT m b c
forall a b. (a -> b) -> a -> b
$ \Entities
w b
b ->
    let ((c
c, d
d), AccessT m ()
access, DynamicReaderSystemT m (b, d) (c, d)
f') = Entities
-> (b, d)
-> ((c, d), AccessT m (), DynamicReaderSystemT m (b, d) (c, d))
f Entities
w (b
b, d
d) in (c
c, AccessT m ()
access, DynamicReaderSystemT m (b, d) (c, d) -> DynamicReaderSystemT m b c
forall b d c.
DynamicReaderSystemT m (b, d) (c, d) -> DynamicReaderSystemT m b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop DynamicReaderSystemT m (b, d) (c, d)
f')

instance (Monad m) => ArrowDynamicReaderSystem DynamicQueryReader (DynamicReaderSystemT m) where
  allDyn :: forall i o.
Set ComponentID
-> DynamicQueryReader i o -> DynamicReaderSystemT m i [o]
allDyn Set ComponentID
cIds DynamicQueryReader i o
q = (Entities
 -> i -> ([o], AccessT m (), DynamicReaderSystemT m i [o]))
-> DynamicReaderSystemT m i [o]
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities
  -> i -> ([o], AccessT m (), DynamicReaderSystemT m i [o]))
 -> DynamicReaderSystemT m i [o])
-> (Entities
    -> i -> ([o], AccessT m (), DynamicReaderSystemT m i [o]))
-> DynamicReaderSystemT m i [o]
forall a b. (a -> b) -> a -> b
$ \Entities
w i
i ->
    let !v :: View
v = Set ComponentID -> Archetypes -> View
V.view Set ComponentID
cIds (Archetypes -> View) -> Archetypes -> View
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
w
     in if View -> Bool
V.null View
v
          then (i -> DynamicQueryReader i o -> [EntityID] -> Archetype -> [o]
forall i o.
i -> DynamicQueryReader i o -> [EntityID] -> Archetype -> [o]
runDynQueryReader i
i DynamicQueryReader i o
q (Map EntityID ArchetypeID -> [EntityID]
forall k a. Map k a -> [k]
Map.keys (Map EntityID ArchetypeID -> [EntityID])
-> Map EntityID ArchetypeID -> [EntityID]
forall a b. (a -> b) -> a -> b
$ Entities -> Map EntityID ArchetypeID
entities Entities
w) Archetype
A.empty, () -> AccessT m ()
forall a. a -> AccessT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), Set ComponentID
-> DynamicQueryReader i o -> DynamicReaderSystemT m i [o]
forall i o.
Set ComponentID
-> DynamicQueryReader i o -> DynamicReaderSystemT m i [o]
forall (q :: * -> * -> *) (arr :: * -> * -> *) i o.
ArrowDynamicReaderSystem q arr =>
Set ComponentID -> q i o -> arr i [o]
allDyn Set ComponentID
cIds DynamicQueryReader i o
q)
          else (i -> DynamicQueryReader i o -> View -> [o]
forall i a. i -> DynamicQueryReader i a -> View -> [a]
V.readAllDyn i
i DynamicQueryReader i o
q View
v, () -> AccessT m ()
forall a. a -> AccessT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), Set ComponentID
-> DynamicQueryReader i o -> DynamicReaderSystemT m i [o]
forall i o.
Set ComponentID
-> DynamicQueryReader i o -> DynamicReaderSystemT m i [o]
forall (q :: * -> * -> *) (arr :: * -> * -> *) i o.
ArrowDynamicReaderSystem q arr =>
Set ComponentID -> q i o -> arr i [o]
allDyn Set ComponentID
cIds DynamicQueryReader i o
q)
  filterDyn :: forall i o.
Set ComponentID
-> DynamicQueryReader i o
-> (Node -> Bool)
-> DynamicReaderSystemT m i [o]
filterDyn Set ComponentID
cIds DynamicQueryReader i o
q Node -> Bool
f = (Entities
 -> i -> ([o], AccessT m (), DynamicReaderSystemT m i [o]))
-> DynamicReaderSystemT m i [o]
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities
  -> i -> ([o], AccessT m (), DynamicReaderSystemT m i [o]))
 -> DynamicReaderSystemT m i [o])
-> (Entities
    -> i -> ([o], AccessT m (), DynamicReaderSystemT m i [o]))
-> DynamicReaderSystemT m i [o]
forall a b. (a -> b) -> a -> b
$ \Entities
w i
i ->
    let !v :: View
v = Set ComponentID -> (Node -> Bool) -> Archetypes -> View
V.filterView Set ComponentID
cIds Node -> Bool
f (Archetypes -> View) -> Archetypes -> View
forall a b. (a -> b) -> a -> b
$ Entities -> Archetypes
archetypes Entities
w
     in (i -> DynamicQueryReader i o -> View -> [o]
forall i a. i -> DynamicQueryReader i a -> View -> [a]
V.readAllDyn i
i DynamicQueryReader i o
q View
v, () -> AccessT m ()
forall a. a -> AccessT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), Set ComponentID
-> DynamicQueryReader i o
-> (Node -> Bool)
-> DynamicReaderSystemT m i [o]
forall i o.
Set ComponentID
-> DynamicQueryReader i o
-> (Node -> Bool)
-> DynamicReaderSystemT m i [o]
forall (q :: * -> * -> *) (arr :: * -> * -> *) i o.
ArrowDynamicReaderSystem q arr =>
Set ComponentID -> q i o -> (Node -> Bool) -> arr i [o]
filterDyn Set ComponentID
cIds DynamicQueryReader i o
q Node -> Bool
f)

instance (Monad m) => ArrowQueueSystem Bundle (AccessT m) (DynamicReaderSystemT m) where
  queue :: forall i. (i -> AccessT m ()) -> DynamicReaderSystemT m i ()
queue i -> AccessT m ()
f = (Entities -> i -> ((), AccessT m (), DynamicReaderSystemT m i ()))
-> DynamicReaderSystemT m i ()
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities -> i -> ((), AccessT m (), DynamicReaderSystemT m i ()))
 -> DynamicReaderSystemT m i ())
-> (Entities
    -> i -> ((), AccessT m (), DynamicReaderSystemT m i ()))
-> DynamicReaderSystemT m i ()
forall a b. (a -> b) -> a -> b
$ \Entities
_ i
i -> let !a :: AccessT m ()
a = i -> AccessT m ()
f i
i in ((), AccessT m ()
a, (i -> AccessT m ()) -> DynamicReaderSystemT m i ()
forall i. (i -> AccessT m ()) -> DynamicReaderSystemT m i ()
forall b (m :: * -> *) (arr :: * -> * -> *) i.
ArrowQueueSystem b m arr =>
(i -> m ()) -> arr i ()
queue i -> AccessT m ()
f)

raceDyn :: (Monad m) => DynamicReaderSystemT m i a -> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i (a, b)
raceDyn :: forall (m :: * -> *) i a b.
Monad m =>
DynamicReaderSystemT m i a
-> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i (a, b)
raceDyn (DynamicReaderSystem Entities -> i -> (a, AccessT m (), DynamicReaderSystemT m i a)
f) (DynamicReaderSystem Entities -> i -> (b, AccessT m (), DynamicReaderSystemT m i b)
g) = (Entities
 -> i -> ((a, b), AccessT m (), DynamicReaderSystemT m i (a, b)))
-> DynamicReaderSystemT m i (a, b)
forall (m :: * -> *) i o.
(Entities -> i -> (o, AccessT m (), DynamicReaderSystemT m i o))
-> DynamicReaderSystemT m i o
DynamicReaderSystem ((Entities
  -> i -> ((a, b), AccessT m (), DynamicReaderSystemT m i (a, b)))
 -> DynamicReaderSystemT m i (a, b))
-> (Entities
    -> i -> ((a, b), AccessT m (), DynamicReaderSystemT m i (a, b)))
-> DynamicReaderSystemT m i (a, b)
forall a b. (a -> b) -> a -> b
$ \Entities
w i
i ->
  let fa :: (a, AccessT m (), DynamicReaderSystemT m i a)
fa = Entities -> i -> (a, AccessT m (), DynamicReaderSystemT m i a)
f Entities
w i
i
      gb :: (b, AccessT m (), DynamicReaderSystemT m i b)
gb = Entities -> i -> (b, AccessT m (), DynamicReaderSystemT m i b)
g Entities
w i
i
      gbPar :: (b, AccessT m (), DynamicReaderSystemT m i b)
gbPar = (a, AccessT m (), DynamicReaderSystemT m i a)
fa (a, AccessT m (), DynamicReaderSystemT m i a)
-> (b, AccessT m (), DynamicReaderSystemT m i b)
-> (b, AccessT m (), DynamicReaderSystemT m i b)
forall a b. a -> b -> b
`par` (b, AccessT m (), DynamicReaderSystemT m i b)
gb
      (a
a, AccessT m ()
fAccess, DynamicReaderSystemT m i a
f') = (a, AccessT m (), DynamicReaderSystemT m i a)
fa
      (b
b, AccessT m ()
gAccess, DynamicReaderSystemT m i b
g') = (b, AccessT m (), DynamicReaderSystemT m i b)
gbPar
   in ((a
a, b
b), AccessT m ()
fAccess AccessT m () -> AccessT m () -> AccessT m ()
forall a b. AccessT m a -> AccessT m b -> AccessT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AccessT m ()
gAccess, DynamicReaderSystemT m i a
-> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i (a, b)
forall (m :: * -> *) i a b.
Monad m =>
DynamicReaderSystemT m i a
-> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i (a, b)
raceDyn DynamicReaderSystemT m i a
f' DynamicReaderSystemT m i b
g')