{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE TypeFamilies        #-}
-----------------------------------------------------------------------------

-- |

-- Module      : Apecs.Effectful

-- Copyright   : (c) Michael Szvetits, 2023

-- License     : BSD-3-Clause (see the file LICENSE)

-- Maintainer  : typedbyte@qualified.name

-- Stability   : stable

-- Portability : portable

--

-- Adaptation of the apecs library for the effectful ecosystem.

-----------------------------------------------------------------------------

module Apecs.Effectful
  ( -- * Effectful Adaptation

    ECS
  , runECS
  , runGC
  , Get
  , Set
  , Destroy
  , Members
  , newEntity
  , newEntity_
  , get
  , tryGet
  , set
  , ($=)
  , destroy
  , exists
  , modify
  , ($~)
  , cmap
  , cmapM
  , cmapM_
  , cfold
  , cfoldM
  , cfoldM_
    -- * Re-exports

  , Entity(..)
  , EntityCounter
  , Not(..)
  , Component(..)
  , Has(..)
  , Cache
  , Global
  , Map
  , Unique
  , SystemT(SystemT)
  , makeWorld
  , makeWorldAndComponents
  , global
  , explInit
  , asks
  ) where

-- apecs

import Apecs      qualified as Apecs
import Apecs.Core qualified as Apecs
import Apecs hiding
  ( Destroy
  , Get
  , Members
  , Set
  , cfold
  , cfoldM
  , cfoldM_
  , cmap
  , cmapM
  , cmapM_
  , exists
  , destroy
  , get
  , modify
  , newEntity
  , newEntity_
  , runGC
  , set
  , ($=)
  , ($~)
  )

-- base

import Data.Kind (Type)

-- effectful-core

import Effectful                 (Eff, Dispatch(Static), DispatchOf, Effect, IOE, (:>))
import Effectful.Dispatch.Static (SideEffects(..), StaticRep, evalStaticRep, getStaticRep, unsafeEff_)

-- vector

import Data.Vector.Unboxed qualified as U

-- | Provide the ability to query and manipulate worlds of type @w@.

data ECS (w :: Type) :: Effect

type instance DispatchOf (ECS w) = Static WithSideEffects

newtype instance StaticRep (ECS w) = ECS w

-- | Indicates that world @w@ has writeable components of type @c@.

type Set w c = Apecs.Set w IO c

-- | Indicates that world @w@ has readable components of type @c@.

type Get w c = Apecs.Get w IO c

-- | Indicates that world @w@ has deletable components of type @c@.

type Destroy w c = Apecs.Destroy w IO c

-- | Indicates that world @w@ contains components of type @c@.

type Members w c = Apecs.Members w IO c

-- | Run the t'ECS' effect using the world initialization function provided by

-- 'makeWorld' or 'makeWorldAndComponents'.

runECS :: IOE :> es => IO w -> Eff (ECS w : es) a -> Eff es a
runECS :: forall (es :: [Effect]) w a.
(IOE :> es) =>
IO w -> Eff (ECS w : es) a -> Eff es a
runECS IO w
worldInit Eff (ECS w : es) a
m = do
  w
w <- forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO w
worldInit
  forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep (forall w. w -> StaticRep (ECS w)
ECS w
w) Eff (ECS w : es) a
m

toEff :: ECS w :> es => System w a -> Eff es a
toEff :: forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff System w a
system = do
  ECS w
w <- forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
  forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. SystemT w m a -> w -> m a
runSystem System w a
system w
w
{-# INLINE toEff #-}

-- | Explicitly invoke the garbage collector.

runGC :: forall w es. ECS w :> es => Eff es ()
runGC :: forall w (es :: [Effect]). (ECS w :> es) => Eff es ()
runGC = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall w. System w ()
Apecs.runGC
{-# INLINE runGC #-}

-- | Writes the given components to a new entity.

newEntity :: forall w c es. (ECS w :> es, Set w c, Get w EntityCounter) => c -> Eff es Entity
newEntity :: forall w c (es :: [Effect]).
(ECS w :> es, Set w c, Get w EntityCounter) =>
c -> Eff es Entity
newEntity = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w c.
(MonadIO m, Set w m c, Get w m EntityCounter) =>
c -> SystemT w m Entity
Apecs.newEntity
{-# INLINE newEntity #-}

-- | Writes the given components to a new entity.

newEntity_ :: forall w c es. (ECS w :> es, Set w c, Get w EntityCounter) => c -> Eff es ()
newEntity_ :: forall w c (es :: [Effect]).
(ECS w :> es, Set w c, Get w EntityCounter) =>
c -> Eff es ()
newEntity_ = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) world component.
(MonadIO m, Set world m component, Get world m EntityCounter) =>
component -> SystemT world m ()
Apecs.newEntity_
{-# INLINE newEntity_ #-}

-- | Read a component from an entity.

get :: forall w c es. (ECS w :> es, Get w c) => Entity -> Eff es c
get :: forall w c (es :: [Effect]).
(ECS w :> es, Get w c) =>
Entity -> Eff es c
get = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) c. Get w m c => Entity -> SystemT w m c
Apecs.get
{-# INLINE get #-}

-- | Read a component from an entity, if available.

tryGet :: forall w c es. (ECS w :> es, Get w c) => Entity -> Eff es (Maybe c)
tryGet :: forall w c (es :: [Effect]).
(ECS w :> es, Get w c) =>
Entity -> Eff es (Maybe c)
tryGet Entity
entity = do
  Bool
existing <- forall c w (es :: [Effect]).
(ECS w :> es, Get w c) =>
Entity -> Eff es Bool
exists @c @w Entity
entity
  if Bool
existing then do
    c
c <- forall w c (es :: [Effect]).
(ECS w :> es, Get w c) =>
Entity -> Eff es c
get @w Entity
entity
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just c
c)
  else
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
{-# INLINE tryGet #-}

-- | Writes a component to a given entity.

set :: forall w c es. (ECS w :> es, Set w c) => Entity -> c -> Eff es ()
set :: forall w c (es :: [Effect]).
(ECS w :> es, Set w c) =>
Entity -> c -> Eff es ()
set Entity
entity = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
Apecs.set Entity
entity
{-# INLINE set #-}

-- | Writes a component to a given entity.

infixr 2 $=
($=) :: forall w c es. (ECS w :> es, Set w c) => Entity -> c -> Eff es ()
$= :: forall w c (es :: [Effect]).
(ECS w :> es, Set w c) =>
Entity -> c -> Eff es ()
($=) Entity
entity = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) c.
Set w m c =>
Entity -> c -> SystemT w m ()
(Apecs.$=) Entity
entity
{-# INLINE ($=) #-}

-- | Destroys component @c@ for the given entity.

destroy :: forall c w es. (ECS w :> es, Destroy w c) => Entity -> Eff es ()
destroy :: forall c w (es :: [Effect]).
(ECS w :> es, Destroy w c) =>
Entity -> Eff es ()
destroy Entity
entity = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) c.
Destroy w m c =>
Entity -> Proxy c -> SystemT w m ()
Apecs.destroy Entity
entity (forall {k} (t :: k). Proxy t
Proxy :: Proxy c)
{-# INLINE destroy #-}

-- | Returns whether the given entity has component @c@.

exists :: forall c w es. (ECS w :> es, Get w c) => Entity -> Eff es Bool
exists :: forall c w (es :: [Effect]).
(ECS w :> es, Get w c) =>
Entity -> Eff es Bool
exists Entity
entity = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) c.
Get w m c =>
Entity -> Proxy c -> SystemT w m Bool
Apecs.exists Entity
entity (forall {k} (t :: k). Proxy t
Proxy :: Proxy c)
{-# INLINE exists #-}

-- | Read a component and writes a new component of an entity.

modify :: forall w cx cy es. (ECS w :> es, Get w cx, Set w cy) => Entity -> (cx -> cy) -> Eff es ()
modify :: forall w cx cy (es :: [Effect]).
(ECS w :> es, Get w cx, Set w cy) =>
Entity -> (cx -> cy) -> Eff es ()
modify Entity
entity = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy) =>
Entity -> (cx -> cy) -> SystemT w m ()
Apecs.modify Entity
entity
{-# INLINE modify #-}

-- | Read the component @cx@ and writes the component @cy@ of an entity.

infixr 2 $~
($~) :: forall w cx cy es. (ECS w :> es, Get w cx, Set w cy) => Entity -> (cx -> cy) -> Eff es ()
$~ :: forall w cx cy (es :: [Effect]).
(ECS w :> es, Get w cx, Set w cy) =>
Entity -> (cx -> cy) -> Eff es ()
($~) Entity
entity = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) cx cy.
(Get w m cx, Set w m cy) =>
Entity -> (cx -> cy) -> SystemT w m ()
(Apecs.$~) Entity
entity
{-# INLINE ($~) #-}

-- | Read the component @cx@ and writes the component @cy@ of all entities.

cmap :: forall w cx cy es. (ECS w :> es, Get w cx, Members w cx, Set w cy) => (cx -> cy) -> Eff es ()
cmap :: forall w cx cy (es :: [Effect]).
(ECS w :> es, Get w cx, Members w cx, Set w cy) =>
(cx -> cy) -> Eff es ()
cmap = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) cx cy.
(Get w m cx, Members w m cx, Set w m cy) =>
(cx -> cy) -> SystemT w m ()
Apecs.cmap
{-# INLINE cmap #-}

-- | Monadic variant of 'cmap'.

cmapM :: forall w cx cy es. (ECS w :> es, Get w cx, Set w cy, Members w cx) => (cx -> Eff es cy) -> Eff es ()
cmapM :: forall w cx cy (es :: [Effect]).
(ECS w :> es, Get w cx, Set w cy, Members w cx) =>
(cx -> Eff es cy) -> Eff es ()
cmapM cx -> Eff es cy
f = do
  Storage cx
sx <- forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w (forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
Apecs.getStore @w @IO @cx)
  Storage cy
sy <- forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w (forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
Apecs.getStore @w @IO @cy)
  Vector Int
sl <- forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
Apecs.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 a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
Apecs.explGet Storage cx
sx Int
e
    cy
y <- cx -> Eff es cy
f cx
x
    forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
Apecs.explSet Storage cy
sy Int
e cy
y
{-# INLINE cmapM #-}

-- | Monadic variant of 'cmap', ignoring the result of the applied function.

cmapM_ :: forall w c es. (ECS w :> es, Get w c, Members w c) => (c -> Eff es ()) -> Eff es ()
cmapM_ :: forall w c (es :: [Effect]).
(ECS w :> es, Get w c, Members w c) =>
(c -> Eff es ()) -> Eff es ()
cmapM_ c -> Eff es ()
f = do
  Storage c
s <- forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w (forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
Apecs.getStore @w @IO @c)
  Vector Int
l <- forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
Apecs.explMembers Storage c
s
  forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Vector a -> (a -> m b) -> m ()
U.forM_ Vector Int
l forall a b. (a -> b) -> a -> b
$ \Int
e ->
    forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
Apecs.explGet Storage c
s Int
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Eff es ()
f
{-# INLINE cmapM_ #-}

-- | Fold over the components @c@ of the game world.

cfold :: forall w c a es. (ECS w :> es, Members w c, Get w c) => (a -> c -> a) -> a -> Eff es a
cfold :: forall w c a (es :: [Effect]).
(ECS w :> es, Members w c, Get w c) =>
(a -> c -> a) -> a -> Eff es a
cfold a -> c -> a
f = forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) c a.
(Members w m c, Get w m c) =>
(a -> c -> a) -> a -> SystemT w m a
Apecs.cfold a -> c -> a
f
{-# INLINE cfold #-}

-- | Monadic variant of 'cfold'.

cfoldM :: forall w c a es. (ECS w :> es, Members w c, Get w c) => (a -> c -> Eff es a) -> a -> Eff es a
cfoldM :: forall w c a (es :: [Effect]).
(ECS w :> es, Members w c, Get w c) =>
(a -> c -> Eff es a) -> a -> Eff es a
cfoldM a -> c -> Eff es a
f a
start = do
  Storage c
s <- forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w (forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
Apecs.getStore @w @IO @c)
  Vector Int
l <- forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
Apecs.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 a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
Apecs.explGet Storage c
s Int
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> c -> Eff es a
f a
a) a
start Vector Int
l
{-# INLINE cfoldM #-}

-- | Monadic variant of 'cfold', ignoring the result.

cfoldM_ :: forall w c a es. (ECS w :> es, Members w c, Get w c) => (a -> c -> Eff es a) -> a -> Eff es ()
cfoldM_ :: forall w c a (es :: [Effect]).
(ECS w :> es, Members w c, Get w c) =>
(a -> c -> Eff es a) -> a -> Eff es ()
cfoldM_ a -> c -> Eff es a
f a
start = do
  Storage c
s <- forall w (es :: [Effect]) a.
(ECS w :> es) =>
System w a -> Eff es a
toEff @w (forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
Apecs.getStore @w @IO @c)
  Vector Int
l <- forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
Apecs.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 a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
Apecs.explGet Storage c
s Int
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> c -> Eff es a
f a
a) a
start Vector Int
l
{-# INLINE cfoldM_ #-}