{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}

module Apecs.System where

import           Control.Monad
import           Control.Monad.Reader
import           Data.Proxy
import qualified Data.Vector.Unboxed  as U

import Apecs.Components ()
import Apecs.Core

-- | Run a system in a game world
{-# INLINE runSystem #-}
runSystem :: SystemT w m a -> w -> m a
runSystem :: forall w (m :: * -> *) a. SystemT w m a -> w -> m a
runSystem SystemT w m a
sys = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall w (m :: * -> *) a. SystemT w m a -> ReaderT w m a
unSystem SystemT w m a
sys)

-- | Run a system in a game world
{-# INLINE runWith #-}
runWith :: w -> SystemT w m a -> m a
runWith :: forall w (m :: * -> *) a. w -> SystemT w m a -> m a
runWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall w (m :: * -> *) a. SystemT w m a -> w -> m a
runSystem

-- | Read a Component
{-# INLINE get #-}
get :: forall w m c. Get w m c => Entity -> SystemT w m c
get :: forall w (m :: * -> *) c. Get w m c => Entity -> SystemT w m c
get (Entity Int
ety) = do
  Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
ety

-- | Writes a Component to a given Entity. Will overwrite existing Components.
{-# INLINE set #-}
set, ($=) :: forall w m c. Set w m c => Entity -> c -> SystemT w m ()
set :: forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
set (Entity Int
ety) c
x = do
  Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage c
s Int
ety c
x

-- | @set@ operator
$= :: forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
($=) = forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
set
infixr 2 $=

-- | Returns whether the given entity has component @c@
{-# INLINE exists #-}
exists :: forall w m c. Get w m c => Entity -> Proxy c -> SystemT w m Bool
exists :: forall w (m :: * -> *) c.
Get w m c =>
Entity -> Proxy c -> SystemT w m Bool
exists (Entity Int
ety) Proxy c
_ = do
  Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists Storage c
s Int
ety

-- | Destroys component @c@ for the given entity.
{-# INLINE destroy #-}
destroy :: forall w m c. Destroy w m c => Entity -> Proxy c -> SystemT w m ()
destroy :: forall w (m :: * -> *) c.
Destroy w m c =>
Entity -> Proxy c -> SystemT w m ()
destroy (Entity Int
ety) ~Proxy c
_ = do
  Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy Storage c
s Int
ety

-- | Applies a function, if possible.
{-# INLINE modify #-}
modify, ($~) :: forall w m cx cy. (Get w m cx, Set w m cy) => Entity -> (cx -> cy) -> SystemT w m ()
modify :: forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy) =>
Entity -> (cx -> cy) -> SystemT w m ()
modify (Entity Int
ety) cx -> cy
f = do
  Storage cx
sx :: Storage cx <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Storage cy
sy :: Storage cy <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ do
    Bool
possible <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists Storage cx
sx Int
ety
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
possible forall a b. (a -> b) -> a -> b
$ do
      cx
x <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
ety
      forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
ety (cx -> cy
f cx
x)

-- | @modify@ operator
$~ :: forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy) =>
Entity -> (cx -> cy) -> SystemT w m ()
($~) = forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy) =>
Entity -> (cx -> cy) -> SystemT w m ()
modify
infixr 2 $~

-- | Maps a function over all entities with a @cx@, and writes their @cy@.
{-# INLINE cmap #-}
cmap :: forall w m cx cy. (Get w m cx, Members w m cx, Set w m cy)
     => (cx -> cy) -> SystemT w m ()
cmap :: forall w (m :: * -> *) cx cy.
(Get w m cx, Members w m cx, Set w m cy) =>
(cx -> cy) -> SystemT w m ()
cmap cx -> cy
f = do
  Storage cx
sx :: Storage cx <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Storage cy
sy :: Storage cy <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ do
    Vector Int
sl <- forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage cx
sx
    forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
      cx
r <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
e
      forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
e (cx -> cy
f cx
r)

-- | Conditional @cmap@, that first tests whether the argument satisfies some property.
--   The entity needs to have both a cx and cp component.
{-# INLINE cmapIf #-}
cmapIf :: forall w m cp cx cy.
  ( Get w m cx
  , Get w m cp
  , Members w m cx
  , Set w m cy )
  => (cp -> Bool)
  -> (cx -> cy)
  -> SystemT w m ()
cmapIf :: forall w (m :: * -> *) cp cx cy.
(Get w m cx, Get w m cp, Members w m cx, Set w m cy) =>
(cp -> Bool) -> (cx -> cy) -> SystemT w m ()
cmapIf cp -> Bool
cond cx -> cy
f = do
  Storage cp
sp :: Storage cp <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Storage cx
sx :: Storage cx <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Storage cy
sy :: Storage cy <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ do
    Vector Int
sl <- forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Storage cx
sx,Storage cp
sp)
    forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
      cp
p <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cp
sp Int
e
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (cp -> Bool
cond cp
p) forall a b. (a -> b) -> a -> b
$ do
        cx
x <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
e
        forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
e (cx -> cy
f cx
x)

-- | Monadically iterates over all entites with a @cx@, and writes their @cy@.
{-# INLINE cmapM #-}
cmapM :: forall w m cx cy. (Get w m cx, Set w m cy, Members w m cx)
      => (cx -> SystemT w m cy) -> SystemT w m ()
cmapM :: forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy, Members w m cx) =>
(cx -> SystemT w m cy) -> SystemT w m ()
cmapM cx -> SystemT w m cy
sys = do
  Storage cx
sx :: Storage cx <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Storage cy
sy :: Storage cy <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage cx
sx
  forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl forall a b. (a -> b) -> a -> b
$ \ Int
e -> do
    cx
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage cx
sx Int
e
    cy
y <- cx -> SystemT w m cy
sys cx
x
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet Storage cy
sy Int
e cy
y

-- | Monadically iterates over all entites with a @cx@
{-# INLINE cmapM_ #-}
cmapM_ :: forall w m c. (Get w m c, Members w m c)
       => (c -> SystemT w m ()) -> SystemT w m ()
cmapM_ :: forall w (m :: * -> *) c.
(Get w m c, Members w m c) =>
(c -> SystemT w m ()) -> SystemT w m ()
cmapM_ c -> SystemT w m ()
sys = do
  Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
  forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
sl forall a b. (a -> b) -> a -> b
$ \ Int
ety -> do
    c
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
ety
    c -> SystemT w m ()
sys c
x

-- | Fold over the game world; for example, @cfold max (minBound :: Foo)@ will find the maximum value of @Foo@.
--   Strict in the accumulator.
{-# INLINE cfold #-}
cfold :: forall w m c a. (Members w m c, Get w m c)
      => (a -> c -> a) -> a -> SystemT w m a
cfold :: forall w (m :: * -> *) c a.
(Members w m c, Get w m c) =>
(a -> c -> a) -> a -> SystemT w m a
cfold a -> c -> a
f a
a0 = do
  Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m a
U.foldM' (\a
a Int
e -> a -> c -> a
f a
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
e) a
a0 Vector Int
sl

-- | Monadically fold over the game world.
--   Strict in the accumulator.
{-# INLINE cfoldM #-}
cfoldM :: forall w m c a. (Members w m c, Get w m c)
       => (a -> c -> SystemT w m a) -> a -> SystemT w m a
cfoldM :: forall w (m :: * -> *) c a.
(Members w m c, Get w m c) =>
(a -> c -> SystemT w m a) -> a -> SystemT w m a
cfoldM a -> c -> SystemT w m a
sys a
a0 = do
  Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
  forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m a
U.foldM' (\a
a Int
e -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> c -> SystemT w m a
sys a
a) a
a0 Vector Int
sl

-- | Monadically fold over the game world.
--   Strict in the accumulator.
{-# INLINE cfoldM_ #-}
cfoldM_ :: forall w m c a. (Members w m c, Get w m c)
       => (a -> c -> SystemT w m a) -> a -> SystemT w m ()
cfoldM_ :: forall w (m :: * -> *) c a.
(Members w m c, Get w m c) =>
(a -> c -> SystemT w m a) -> a -> SystemT w m ()
cfoldM_ a -> c -> SystemT w m a
sys a
a0 = do
  Storage c
s :: Storage c <- forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
  Vector Int
sl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers Storage c
s
  forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m ()
U.foldM'_ (\a
a Int
e -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet Storage c
s Int
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> c -> SystemT w m a
sys a
a) a
a0 Vector Int
sl

-- | Collect matching components into a list by using the specified test/process function.
--   You can use this to preprocess data before returning.
--   And you can do a test here that depends on data from multiple components.
--   Pass "Just" to simply collect all the items.
{-# INLINE collect #-}
collect :: forall components w m a. (Get w m components, Members w m components)
        => (components -> Maybe a)
        -> SystemT w m [a]
collect :: forall components w (m :: * -> *) a.
(Get w m components, Members w m components) =>
(components -> Maybe a) -> SystemT w m [a]
collect components -> Maybe a
f = forall w (m :: * -> *) c a.
(Members w m c, Get w m c) =>
(a -> c -> a) -> a -> SystemT w m a
cfold (\[a]
acc -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
acc (forall a. a -> [a] -> [a]
: [a]
acc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. components -> Maybe a
f) []