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

module Aztecs.ECS.System.Reader
  ( ReaderSystem,
    ReaderSystemT (..),
    ArrowReaderSystem (..),
    ArrowQueueSystem (..),
  )
where

import Aztecs.ECS.Access (AccessT)
import Aztecs.ECS.Query.Reader
import Aztecs.ECS.System.Dynamic.Reader
import Aztecs.ECS.System.Reader.Class (ArrowReaderSystem (..))
import qualified Aztecs.ECS.World.Archetype as A
import Aztecs.ECS.World.Archetypes (Node (..))
import Aztecs.ECS.World.Bundle (Bundle)
import Aztecs.ECS.World.Components (ComponentID, Components)
import Control.Arrow
import Control.Category
import Control.Monad.Identity
import qualified Data.Foldable as F
import Data.Set (Set)
import Prelude hiding (id, (.))

type ReaderSystem = ReaderSystemT Identity

-- | System to process entities.
newtype ReaderSystemT m i o = ReaderSystem
  { -- | Run a system, producing a `DynamicSystem` that can be repeatedly run.
    forall (m :: * -> *) i o.
ReaderSystemT m i o
-> Components
-> (DynamicReaderSystemT m i o, Set ComponentID, Components)
runReaderSystem :: Components -> (DynamicReaderSystemT m i o, Set ComponentID, Components)
  }
  deriving ((forall a b.
 (a -> b) -> ReaderSystemT m i a -> ReaderSystemT m i b)
-> (forall a b. a -> ReaderSystemT m i b -> ReaderSystemT m i a)
-> Functor (ReaderSystemT m i)
forall a b. a -> ReaderSystemT m i b -> ReaderSystemT m i a
forall a b. (a -> b) -> ReaderSystemT m i a -> ReaderSystemT 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 -> ReaderSystemT m i b -> ReaderSystemT m i a
forall (m :: * -> *) i a b.
(a -> b) -> ReaderSystemT m i a -> ReaderSystemT m i b
$cfmap :: forall (m :: * -> *) i a b.
(a -> b) -> ReaderSystemT m i a -> ReaderSystemT m i b
fmap :: forall a b. (a -> b) -> ReaderSystemT m i a -> ReaderSystemT m i b
$c<$ :: forall (m :: * -> *) i a b.
a -> ReaderSystemT m i b -> ReaderSystemT m i a
<$ :: forall a b. a -> ReaderSystemT m i b -> ReaderSystemT m i a
Functor)

instance (Monad m) => Category (ReaderSystemT m) where
  id :: forall a. ReaderSystemT m a a
id = (Components
 -> (DynamicReaderSystemT m a a, Set ComponentID, Components))
-> ReaderSystemT m a a
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m a a, Set ComponentID, Components))
 -> ReaderSystemT m a a)
-> (Components
    -> (DynamicReaderSystemT m a a, Set ComponentID, Components))
-> ReaderSystemT m a a
forall a b. (a -> b) -> a -> b
$ \Components
cs -> (DynamicReaderSystemT m a a
forall a. DynamicReaderSystemT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, Set ComponentID
forall a. Monoid a => a
mempty, Components
cs)
  ReaderSystem Components
-> (DynamicReaderSystemT m b c, Set ComponentID, Components)
f . :: forall b c a.
ReaderSystemT m b c -> ReaderSystemT m a b -> ReaderSystemT m a c
. ReaderSystem Components
-> (DynamicReaderSystemT m a b, Set ComponentID, Components)
g = (Components
 -> (DynamicReaderSystemT m a c, Set ComponentID, Components))
-> ReaderSystemT m a c
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m a c, Set ComponentID, Components))
 -> ReaderSystemT m a c)
-> (Components
    -> (DynamicReaderSystemT m a c, Set ComponentID, Components))
-> ReaderSystemT m a c
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let (DynamicReaderSystemT m b c
f', Set ComponentID
rwsF, Components
cs') = Components
-> (DynamicReaderSystemT m b c, Set ComponentID, Components)
f Components
cs
        (DynamicReaderSystemT m a b
g', Set ComponentID
rwsG, Components
cs'') = Components
-> (DynamicReaderSystemT m a b, Set ComponentID, Components)
g Components
cs'
     in (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', Set ComponentID
rwsF Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Set ComponentID
rwsG, Components
cs'')

instance (Monad m) => Arrow (ReaderSystemT m) where
  arr :: forall b c. (b -> c) -> ReaderSystemT m b c
arr b -> c
f = (Components
 -> (DynamicReaderSystemT m b c, Set ComponentID, Components))
-> ReaderSystemT m b c
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m b c, Set ComponentID, Components))
 -> ReaderSystemT m b c)
-> (Components
    -> (DynamicReaderSystemT m b c, Set ComponentID, Components))
-> ReaderSystemT m b c
forall a b. (a -> b) -> a -> b
$ \Components
cs -> ((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, Set ComponentID
forall a. Monoid a => a
mempty, Components
cs)
  first :: forall b c d. ReaderSystemT m b c -> ReaderSystemT m (b, d) (c, d)
first (ReaderSystem Components
-> (DynamicReaderSystemT m b c, Set ComponentID, Components)
f) = (Components
 -> (DynamicReaderSystemT m (b, d) (c, d), Set ComponentID,
     Components))
-> ReaderSystemT m (b, d) (c, d)
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m (b, d) (c, d), Set ComponentID,
      Components))
 -> ReaderSystemT m (b, d) (c, d))
-> (Components
    -> (DynamicReaderSystemT m (b, d) (c, d), Set ComponentID,
        Components))
-> ReaderSystemT m (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let (DynamicReaderSystemT m b c
f', Set ComponentID
rwsF, Components
cs') = Components
-> (DynamicReaderSystemT m b c, Set ComponentID, Components)
f Components
cs in (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', Set ComponentID
rwsF, Components
cs')
  ReaderSystemT m b c
f &&& :: forall b c c'.
ReaderSystemT m b c
-> ReaderSystemT m b c' -> ReaderSystemT m b (c, c')
&&& ReaderSystemT m b c'
g = (Components
 -> (DynamicReaderSystemT m b (c, c'), Set ComponentID, Components))
-> ReaderSystemT m b (c, c')
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m b (c, c'), Set ComponentID, Components))
 -> ReaderSystemT m b (c, c'))
-> (Components
    -> (DynamicReaderSystemT m b (c, c'), Set ComponentID, Components))
-> ReaderSystemT m b (c, c')
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let (DynamicReaderSystemT m b c
dynF, Set ComponentID
rwsA, Components
cs') = ReaderSystemT m b c
-> Components
-> (DynamicReaderSystemT m b c, Set ComponentID, Components)
forall (m :: * -> *) i o.
ReaderSystemT m i o
-> Components
-> (DynamicReaderSystemT m i o, Set ComponentID, Components)
runReaderSystem ReaderSystemT m b c
f Components
cs
        (DynamicReaderSystemT m b c'
dynG, Set ComponentID
rwsB, Components
cs'') = ReaderSystemT m b c'
-> Components
-> (DynamicReaderSystemT m b c', Set ComponentID, Components)
forall (m :: * -> *) i o.
ReaderSystemT m i o
-> Components
-> (DynamicReaderSystemT m i o, Set ComponentID, Components)
runReaderSystem ReaderSystemT m b c'
g Components
cs'
     in (DynamicReaderSystemT m b c
-> DynamicReaderSystemT m b c' -> DynamicReaderSystemT m b (c, c')
forall (m :: * -> *) i a b.
Monad m =>
DynamicReaderSystemT m i a
-> DynamicReaderSystemT m i b -> DynamicReaderSystemT m i (a, b)
raceDyn DynamicReaderSystemT m b c
dynF DynamicReaderSystemT m b c'
dynG, Set ComponentID
rwsA Set ComponentID -> Set ComponentID -> Set ComponentID
forall a. Semigroup a => a -> a -> a
<> Set ComponentID
rwsB, Components
cs'')

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

instance (Monad m) => ArrowLoop (ReaderSystemT m) where
  loop :: forall b d c. ReaderSystemT m (b, d) (c, d) -> ReaderSystemT m b c
loop (ReaderSystem Components
-> (DynamicReaderSystemT m (b, d) (c, d), Set ComponentID,
    Components)
f) = (Components
 -> (DynamicReaderSystemT m b c, Set ComponentID, Components))
-> ReaderSystemT m b c
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m b c, Set ComponentID, Components))
 -> ReaderSystemT m b c)
-> (Components
    -> (DynamicReaderSystemT m b c, Set ComponentID, Components))
-> ReaderSystemT m b c
forall a b. (a -> b) -> a -> b
$ \Components
cs -> let (DynamicReaderSystemT m (b, d) (c, d)
f', Set ComponentID
rwsF, Components
cs') = Components
-> (DynamicReaderSystemT m (b, d) (c, d), Set ComponentID,
    Components)
f Components
cs in (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', Set ComponentID
rwsF, Components
cs')

instance (Monad m) => ArrowReaderSystem QueryReader (ReaderSystemT m) where
  all :: forall i a. QueryReader i a -> ReaderSystemT m i [a]
all QueryReader i a
q = (Components
 -> (DynamicReaderSystemT m i [a], Set ComponentID, Components))
-> ReaderSystemT m i [a]
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m i [a], Set ComponentID, Components))
 -> ReaderSystemT m i [a])
-> (Components
    -> (DynamicReaderSystemT m i [a], Set ComponentID, Components))
-> ReaderSystemT m i [a]
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let !(Set ComponentID
rs, Components
cs', DynamicQueryReader i a
dynQ) = QueryReader i a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader i a)
forall i o.
QueryReader i o
-> Components
-> (Set ComponentID, Components, DynamicQueryReader i o)
runQueryReader QueryReader i a
q Components
cs in (Set ComponentID
-> DynamicQueryReader i a -> DynamicReaderSystemT m i [a]
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
rs DynamicQueryReader i a
dynQ, Set ComponentID
rs, Components
cs')
  filter :: forall a. QueryReader () a -> QueryFilter -> ReaderSystemT m () [a]
filter QueryReader () a
q QueryFilter
qf = (Components
 -> (DynamicReaderSystemT m () [a], Set ComponentID, Components))
-> ReaderSystemT m () [a]
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m () [a], Set ComponentID, Components))
 -> ReaderSystemT m () [a])
-> (Components
    -> (DynamicReaderSystemT m () [a], Set ComponentID, Components))
-> ReaderSystemT m () [a]
forall a b. (a -> b) -> a -> b
$ \Components
cs ->
    let !(Set ComponentID
rs, Components
cs', DynamicQueryReader () a
dynQ) = QueryReader () a
-> Components
-> (Set ComponentID, Components, DynamicQueryReader () a)
forall i o.
QueryReader i o
-> Components
-> (Set ComponentID, Components, DynamicQueryReader i o)
runQueryReader QueryReader () a
q Components
cs
        !(DynamicQueryFilter
dynQf, Components
cs'') = QueryFilter -> Components -> (DynamicQueryFilter, Components)
runQueryFilter QueryFilter
qf Components
cs'
        qf' :: Node -> Bool
qf' Node
n =
          (ComponentID -> Bool) -> Set ComponentID -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (\ComponentID
cId -> ComponentID -> Archetype -> Bool
A.member ComponentID
cId (Archetype -> Bool) -> Archetype -> Bool
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n) (DynamicQueryFilter -> Set ComponentID
filterWith DynamicQueryFilter
dynQf)
            Bool -> Bool -> Bool
&& (ComponentID -> Bool) -> Set ComponentID -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (\ComponentID
cId -> Bool -> Bool
not (ComponentID -> Archetype -> Bool
A.member ComponentID
cId (Archetype -> Bool) -> Archetype -> Bool
forall a b. (a -> b) -> a -> b
$ Node -> Archetype
nodeArchetype Node
n)) (DynamicQueryFilter -> Set ComponentID
filterWithout DynamicQueryFilter
dynQf)
     in (Set ComponentID
-> DynamicQueryReader () a
-> (Node -> Bool)
-> DynamicReaderSystemT m () [a]
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
rs DynamicQueryReader () a
dynQ Node -> Bool
qf', Set ComponentID
rs, Components
cs'')

instance (Monad m) => ArrowQueueSystem Bundle (AccessT m) (ReaderSystemT m) where
  queue :: forall i. (i -> AccessT m ()) -> ReaderSystemT m i ()
queue i -> AccessT m ()
f = (Components
 -> (DynamicReaderSystemT m i (), Set ComponentID, Components))
-> ReaderSystemT m i ()
forall (m :: * -> *) i o.
(Components
 -> (DynamicReaderSystemT m i o, Set ComponentID, Components))
-> ReaderSystemT m i o
ReaderSystem ((Components
  -> (DynamicReaderSystemT m i (), Set ComponentID, Components))
 -> ReaderSystemT m i ())
-> (Components
    -> (DynamicReaderSystemT m i (), Set ComponentID, Components))
-> ReaderSystemT m i ()
forall a b. (a -> b) -> a -> b
$ \Components
cs -> ((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, Set ComponentID
forall a. Monoid a => a
mempty, Components
cs)