{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Mischief.ECS.World
  ( -- * World
    World (..),
    newWorld,
    setSystemId,
    setDeferred,
    Frame (..),
    SystemTools (..),
    worldGet,
    worldGetRAny,
    worldSet,
    worldSpawnByInsert,

    -- * Prefs
    PrefType,
    setPref,
    getPref,
    SupressEventsPref,

    -- * Systems
    System (..),
    SystemId (..),
    runWhen,
    runSystem,
    MonadSystem,
    unsafeGetWorld,
    sysUnliftIO,
    SystemAny (..),

    -- * Parallel
    ParSystem (..),
    ParWorld (..),
    parLift,
  )
where

import Colog qualified
import Control.Concurrent.STM (TVar, newTVarIO)
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Primitive (PrimMonad (..), RealWorld)
import Control.Monad.Reader.Class (MonadReader (..), asks)
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Trans.Reader (ReaderT (runReaderT))
import Data.Data
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.Map (Map)
import Data.Map qualified as Map
import Mischief.ECS.Archetypes (Archetypes, emptyArchetypes)
import Mischief.ECS.Collectable
import Mischief.ECS.Components
  ( Component (IsExclusiveRel),
    Components,
    Rel,
    Tick (Tick),
    emptyComponents,
  )
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Entities
  ( Entities,
    Entity (Entity),
    emptyEntities,
  )
import Mischief.ECS.Hidden
import Mischief.ECS.Tables (Tables, emptyTables)
import Mischief.ECS.Utils (ErasedValue (..), eraseValue, unsafeUneraseValue)

-- | @The World@ is the main data structure storing the entities, components, archetypes, and everything else that lives in our app.
data World = World
  { -- | Archetype storage.
    World -> Archetypes
archetypes :: Archetypes,
    -- | Components storage.
    World -> Components
components :: Components,
    -- | Entities storage.
    World -> Entities
entities :: Entities,
    -- | Archetype tables. Storage for the actual data of components.
    World -> Tables
tables :: Tables,
    -- | List of deferred system to be ran at the next sync point. They can also be flushed manually using 'flush'.
    World -> IORef [System ()]
deferred :: IORef [System ()],
    -- | Secondary list of deferred systems stored in a TVar, meant to be used when running systems asynchronously.
    -- They are ran at the first available sync point, and can also be flushed manually with 'flushAsync'.
    World -> TVar [System ()]
deferredAsync :: TVar [System ()],
    -- | Systems to be tried at the next sync point. If the first system returns a Just, it is removed from the list and the second
    -- system is ran with the returned value.
    World
-> IORef [(System (Maybe ErasedValue), ErasedValue -> System ())]
trySystems :: IORef [(System (Maybe ErasedValue), ErasedValue -> System ())],
    -- | The current tick, incremented each time a system is ran, used for change detection.
    World -> IORef Tick
tick :: IORef Tick,
    -- | Id of the current system.
    World -> SystemId
systemId :: SystemId,
    -- | The current frame.
    World -> IORef Frame
frame :: IORef Frame,
    -- | Certain toggleable settings.
    World -> Prefs
prefs :: Prefs,
    World -> LogAction IO Message
logger :: Colog.LogAction IO Colog.Message,
    World -> LogAction IO Message
loggerErr :: Colog.LogAction IO Colog.Message,
    World -> SystemTools
tools :: SystemTools
  }

newtype Prefs = Prefs (Map TypeRep Pref)

data Pref where
  Pref :: (Typeable a) => a -> Pref

class (Typeable a, Typeable b) => PrefType a b | a -> b

data SupressEventsPref

instance PrefType SupressEventsPref Bool

worldSetPref :: forall a b. (PrefType a b) => b -> World -> World
worldSetPref :: forall {k} (a :: k) b. PrefType a b => b -> World -> World
worldSetPref !b
value !World
world =
  let Prefs !Map TypeRep Pref
prefs = World
world.prefs
   in World
world {prefs = Prefs $ Map.insert (typeRep $ Proxy @a) (Pref value) prefs}

worldGetPref :: forall a b. (PrefType a b) => World -> Maybe b
worldGetPref :: forall {k} (a :: k) b. PrefType a b => World -> Maybe b
worldGetPref World {prefs :: World -> Prefs
prefs = Prefs !Map TypeRep Pref
prefs} = forall (a :: k) b. PrefType a b => Pref -> Maybe b
forall {k} (a :: k) b. PrefType a b => Pref -> Maybe b
worldGetPref' @a (Pref -> Maybe b) -> Maybe Pref -> Maybe b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TypeRep -> Map TypeRep Pref -> Maybe Pref
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) Map TypeRep Pref
prefs

worldGetPref' :: forall a b. (PrefType a b) => Pref -> Maybe b
worldGetPref' :: forall {k} (a :: k) b. PrefType a b => Pref -> Maybe b
worldGetPref' (Pref (!a
s :: a')) =
  case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @a' @b of
    Just a :~: b
Refl -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
s
    Maybe (a :~: b)
Nothing -> Maybe b
forall a. Maybe a
Nothing

setPref :: forall a b c. (PrefType a b) => b -> System c -> System c
setPref :: forall {k} (a :: k) b c. PrefType a b => b -> System c -> System c
setPref !b
value !System c
s = do
  !world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let world' = forall (a :: k) b. PrefType a b => b -> World -> World
forall {k} (a :: k) b. PrefType a b => b -> World -> World
worldSetPref @a b
value World
world
  liftIO $ runSystem s world'

getPref :: forall a m b w. (PrefType a b, MonadSystem w m) => m (Maybe b)
getPref :: forall {k} (a :: k) (m :: * -> *) b w.
(PrefType a b, MonadSystem w m) =>
m (Maybe b)
getPref = forall (a :: k) b. PrefType a b => World -> Maybe b
forall {k} (a :: k) b. PrefType a b => World -> Maybe b
worldGetPref @a (World -> Maybe b) -> m World -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld

newtype Frame = Frame Int deriving (Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
(Int -> Frame -> ShowS)
-> (Frame -> String) -> ([Frame] -> ShowS) -> Show Frame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Frame -> ShowS
showsPrec :: Int -> Frame -> ShowS
$cshow :: Frame -> String
show :: Frame -> String
$cshowList :: [Frame] -> ShowS
showList :: [Frame] -> ShowS
Show, Frame -> Frame -> Bool
(Frame -> Frame -> Bool) -> (Frame -> Frame -> Bool) -> Eq Frame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Frame -> Frame -> Bool
== :: Frame -> Frame -> Bool
$c/= :: Frame -> Frame -> Bool
/= :: Frame -> Frame -> Bool
Eq, Eq Frame
Eq Frame =>
(Frame -> Frame -> Ordering)
-> (Frame -> Frame -> Bool)
-> (Frame -> Frame -> Bool)
-> (Frame -> Frame -> Bool)
-> (Frame -> Frame -> Bool)
-> (Frame -> Frame -> Frame)
-> (Frame -> Frame -> Frame)
-> Ord Frame
Frame -> Frame -> Bool
Frame -> Frame -> Ordering
Frame -> Frame -> Frame
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Frame -> Frame -> Ordering
compare :: Frame -> Frame -> Ordering
$c< :: Frame -> Frame -> Bool
< :: Frame -> Frame -> Bool
$c<= :: Frame -> Frame -> Bool
<= :: Frame -> Frame -> Bool
$c> :: Frame -> Frame -> Bool
> :: Frame -> Frame -> Bool
$c>= :: Frame -> Frame -> Bool
>= :: Frame -> Frame -> Bool
$cmax :: Frame -> Frame -> Frame
max :: Frame -> Frame -> Frame
$cmin :: Frame -> Frame -> Frame
min :: Frame -> Frame -> Frame
Ord)

-- | Unique id assigned to each system that's added to a schedule. Just a wrapper around Entity.
newtype SystemId = SystemId {SystemId -> Entity
id :: Entity} deriving (Int -> SystemId -> ShowS
[SystemId] -> ShowS
SystemId -> String
(Int -> SystemId -> ShowS)
-> (SystemId -> String) -> ([SystemId] -> ShowS) -> Show SystemId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SystemId -> ShowS
showsPrec :: Int -> SystemId -> ShowS
$cshow :: SystemId -> String
show :: SystemId -> String
$cshowList :: [SystemId] -> ShowS
showList :: [SystemId] -> ShowS
Show, SystemId -> SystemId -> Bool
(SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> Bool) -> Eq SystemId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SystemId -> SystemId -> Bool
== :: SystemId -> SystemId -> Bool
$c/= :: SystemId -> SystemId -> Bool
/= :: SystemId -> SystemId -> Bool
Eq, Eq SystemId
Eq SystemId =>
(SystemId -> SystemId -> Ordering)
-> (SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> SystemId)
-> (SystemId -> SystemId -> SystemId)
-> Ord SystemId
SystemId -> SystemId -> Bool
SystemId -> SystemId -> Ordering
SystemId -> SystemId -> SystemId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SystemId -> SystemId -> Ordering
compare :: SystemId -> SystemId -> Ordering
$c< :: SystemId -> SystemId -> Bool
< :: SystemId -> SystemId -> Bool
$c<= :: SystemId -> SystemId -> Bool
<= :: SystemId -> SystemId -> Bool
$c> :: SystemId -> SystemId -> Bool
> :: SystemId -> SystemId -> Bool
$c>= :: SystemId -> SystemId -> Bool
>= :: SystemId -> SystemId -> Bool
$cmax :: SystemId -> SystemId -> SystemId
max :: SystemId -> SystemId -> SystemId
$cmin :: SystemId -> SystemId -> SystemId
min :: SystemId -> SystemId -> SystemId
Ord)

-- | Create a new World in IO.
newWorld :: SystemTools -> IO World
newWorld :: SystemTools -> IO World
newWorld !SystemTools
tools = do
  !archetypes <- IO Archetypes
emptyArchetypes
  !components <- emptyComponents
  !entities <- emptyEntities
  !tables <- emptyTables
  !deferred <- newIORef []
  !deferredAsync <- newTVarIO []
  !tick <- newIORef (Tick 0)
  !frame <- newIORef (Frame 0)
  !trySystems <- newIORef []
  let !prefs = Map TypeRep Pref -> Prefs
Prefs Map TypeRep Pref
forall k a. Map k a
Map.empty

  let !logger = (Message -> Text) -> LogAction IO Text -> LogAction IO Message
forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
Colog.cmap Message -> Text
Colog.fmtMessage LogAction IO Text
forall (m :: * -> *). MonadIO m => LogAction m Text
Colog.logTextStdout
  let !loggerErr = (Message -> Text) -> LogAction IO Text -> LogAction IO Message
forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
Colog.cmap Message -> Text
Colog.fmtMessage LogAction IO Text
forall (m :: * -> *). MonadIO m => LogAction m Text
Colog.logTextStderr

  pure
    World
      { archetypes,
        components,
        entities,
        tables,
        deferred,
        deferredAsync,
        tick,
        systemId = SystemId (Entity (# 0##, 0## #)),
        frame,
        prefs,
        logger,
        loggerErr,
        trySystems,
        tools
      }

-- | Change the current SystemId of the World.
setSystemId :: SystemId -> World -> World
setSystemId :: SystemId -> World -> World
setSystemId !SystemId
systemId !World
world = World
world {systemId}

-- | Set the list of deferred systems of the World.
setDeferred :: IORef [System ()] -> World -> World
setDeferred :: IORef [System ()] -> World -> World
setDeferred !IORef [System ()]
deferred !World
world = World
world {deferred}

-- | A System is a monad that mutates the World.
--
-- It can be added to a certain schedule and ordered with other systems.
-- It also offers IO access via 'liftIO'.
--
-- Read the [tutorial]("Mischief.ECS.Tutorial.Systems") on systems for more details.
newtype System a = System (ReaderT (Hidden World) IO a)
  deriving newtype ((forall a b. (a -> b) -> System a -> System b)
-> (forall a b. a -> System b -> System a) -> Functor System
forall a b. a -> System b -> System a
forall a b. (a -> b) -> System a -> System b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> System a -> System b
fmap :: forall a b. (a -> b) -> System a -> System b
$c<$ :: forall a b. a -> System b -> System a
<$ :: forall a b. a -> System b -> System a
Functor, Functor System
Functor System =>
(forall a. a -> System a)
-> (forall a b. System (a -> b) -> System a -> System b)
-> (forall a b c.
    (a -> b -> c) -> System a -> System b -> System c)
-> (forall a b. System a -> System b -> System b)
-> (forall a b. System a -> System b -> System a)
-> Applicative System
forall a. a -> System a
forall a b. System a -> System b -> System a
forall a b. System a -> System b -> System b
forall a b. System (a -> b) -> System a -> System b
forall a b c. (a -> b -> c) -> System a -> System b -> System c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> System a
pure :: forall a. a -> System a
$c<*> :: forall a b. System (a -> b) -> System a -> System b
<*> :: forall a b. System (a -> b) -> System a -> System b
$cliftA2 :: forall a b c. (a -> b -> c) -> System a -> System b -> System c
liftA2 :: forall a b c. (a -> b -> c) -> System a -> System b -> System c
$c*> :: forall a b. System a -> System b -> System b
*> :: forall a b. System a -> System b -> System b
$c<* :: forall a b. System a -> System b -> System a
<* :: forall a b. System a -> System b -> System a
Applicative, Applicative System
Applicative System =>
(forall a b. System a -> (a -> System b) -> System b)
-> (forall a b. System a -> System b -> System b)
-> (forall a. a -> System a)
-> Monad System
forall a. a -> System a
forall a b. System a -> System b -> System b
forall a b. System a -> (a -> System b) -> System b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. System a -> (a -> System b) -> System b
>>= :: forall a b. System a -> (a -> System b) -> System b
$c>> :: forall a b. System a -> System b -> System b
>> :: forall a b. System a -> System b -> System b
$creturn :: forall a. a -> System a
return :: forall a. a -> System a
Monad, Monad System
Monad System => (forall a. IO a -> System a) -> MonadIO System
forall a. IO a -> System a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> System a
liftIO :: forall a. IO a -> System a
MonadIO, MonadReader (Hidden World), Monad System
Monad System => (forall a. String -> System a) -> MonadFail System
forall a. String -> System a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> System a
fail :: forall a. String -> System a
MonadFail, Monad System
Monad System =>
(forall e a. (HasCallStack, Exception e) => e -> System a)
-> MonadThrow System
forall e a. (HasCallStack, Exception e) => e -> System a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> System a
throwM :: forall e a. (HasCallStack, Exception e) => e -> System a
MonadThrow)

-- | Run a 'System' with the given 'World' inside 'IO'
runSystem :: System a -> World -> IO a
runSystem :: forall a. System a -> World -> IO a
runSystem (System !ReaderT (Hidden World) IO a
r) !World
w = ReaderT (Hidden World) IO a -> Hidden World -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Hidden World) IO a
r (World -> Hidden World
forall a. a -> Hidden a
hide World
w)

-- runSystem' :: (MonadSystem w m) => m a -> World -> IO a
-- runSystem' (System !r) w =

instance PrimMonad System where
  type PrimState System = PrimState IO
  primitive :: forall a.
(State# (PrimState System) -> (# State# (PrimState System), a #))
-> System a
primitive = ReaderT (Hidden World) IO a -> System a
forall a. ReaderT (Hidden World) IO a -> System a
System (ReaderT (Hidden World) IO a -> System a)
-> ((State# RealWorld -> (# State# RealWorld, a #))
    -> ReaderT (Hidden World) IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> System a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT (Hidden World) IO a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Hidden World) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> ReaderT (Hidden World) IO a)
-> ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> ReaderT (Hidden World) IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
(State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
forall a.
(State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

-- | Special wrapper around World given to 'ParSystem's.
data ParWorld = ParWorld
  { -- | @Hidden@ ensures users cannot access and mutate the World.
    ParWorld -> Hidden World
world :: Hidden World,
    -- | Deferred systems will be collected in this dedicated list and then
    -- merged back into the main deferred list once the parallel systems are joined.
    ParWorld -> IORef [System ()]
parDeferred :: IORef [System ()]
  }

-- | A variant of 'System' that contains a 'ParWorld' instead of 'World'.
--
-- @Parallel systems@ will only be able to run systems that are either specifically intended for them or
-- are made to work with any @'MonadSystem'@ (such as queries).
--
-- To run a normal @System ()@, you need to 'Mischief.ECS.World.Defer.defer'!
newtype ParSystem a = ParSystem (ReaderT ParWorld IO a)
  deriving newtype ((forall a b. (a -> b) -> ParSystem a -> ParSystem b)
-> (forall a b. a -> ParSystem b -> ParSystem a)
-> Functor ParSystem
forall a b. a -> ParSystem b -> ParSystem a
forall a b. (a -> b) -> ParSystem a -> ParSystem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ParSystem a -> ParSystem b
fmap :: forall a b. (a -> b) -> ParSystem a -> ParSystem b
$c<$ :: forall a b. a -> ParSystem b -> ParSystem a
<$ :: forall a b. a -> ParSystem b -> ParSystem a
Functor, Functor ParSystem
Functor ParSystem =>
(forall a. a -> ParSystem a)
-> (forall a b. ParSystem (a -> b) -> ParSystem a -> ParSystem b)
-> (forall a b c.
    (a -> b -> c) -> ParSystem a -> ParSystem b -> ParSystem c)
-> (forall a b. ParSystem a -> ParSystem b -> ParSystem b)
-> (forall a b. ParSystem a -> ParSystem b -> ParSystem a)
-> Applicative ParSystem
forall a. a -> ParSystem a
forall a b. ParSystem a -> ParSystem b -> ParSystem a
forall a b. ParSystem a -> ParSystem b -> ParSystem b
forall a b. ParSystem (a -> b) -> ParSystem a -> ParSystem b
forall a b c.
(a -> b -> c) -> ParSystem a -> ParSystem b -> ParSystem c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ParSystem a
pure :: forall a. a -> ParSystem a
$c<*> :: forall a b. ParSystem (a -> b) -> ParSystem a -> ParSystem b
<*> :: forall a b. ParSystem (a -> b) -> ParSystem a -> ParSystem b
$cliftA2 :: forall a b c.
(a -> b -> c) -> ParSystem a -> ParSystem b -> ParSystem c
liftA2 :: forall a b c.
(a -> b -> c) -> ParSystem a -> ParSystem b -> ParSystem c
$c*> :: forall a b. ParSystem a -> ParSystem b -> ParSystem b
*> :: forall a b. ParSystem a -> ParSystem b -> ParSystem b
$c<* :: forall a b. ParSystem a -> ParSystem b -> ParSystem a
<* :: forall a b. ParSystem a -> ParSystem b -> ParSystem a
Applicative, Applicative ParSystem
Applicative ParSystem =>
(forall a b. ParSystem a -> (a -> ParSystem b) -> ParSystem b)
-> (forall a b. ParSystem a -> ParSystem b -> ParSystem b)
-> (forall a. a -> ParSystem a)
-> Monad ParSystem
forall a. a -> ParSystem a
forall a b. ParSystem a -> ParSystem b -> ParSystem b
forall a b. ParSystem a -> (a -> ParSystem b) -> ParSystem b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. ParSystem a -> (a -> ParSystem b) -> ParSystem b
>>= :: forall a b. ParSystem a -> (a -> ParSystem b) -> ParSystem b
$c>> :: forall a b. ParSystem a -> ParSystem b -> ParSystem b
>> :: forall a b. ParSystem a -> ParSystem b -> ParSystem b
$creturn :: forall a. a -> ParSystem a
return :: forall a. a -> ParSystem a
Monad, Monad ParSystem
Monad ParSystem =>
(forall a. IO a -> ParSystem a) -> MonadIO ParSystem
forall a. IO a -> ParSystem a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> ParSystem a
liftIO :: forall a. IO a -> ParSystem a
MonadIO, MonadReader ParWorld, Monad ParSystem
Monad ParSystem =>
(forall a. String -> ParSystem a) -> MonadFail ParSystem
forall a. String -> ParSystem a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> ParSystem a
fail :: forall a. String -> ParSystem a
MonadFail, Monad ParSystem
Monad ParSystem =>
(forall a.
 (State# (PrimState ParSystem)
  -> (# State# (PrimState ParSystem), a #))
 -> ParSystem a)
-> PrimMonad ParSystem
forall a.
(State# (PrimState ParSystem)
 -> (# State# (PrimState ParSystem), a #))
-> ParSystem a
forall (m :: * -> *).
Monad m =>
(forall a.
 (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> PrimMonad m
$cprimitive :: forall a.
(State# (PrimState ParSystem)
 -> (# State# (PrimState ParSystem), a #))
-> ParSystem a
primitive :: forall a.
(State# (PrimState ParSystem)
 -> (# State# (PrimState ParSystem), a #))
-> ParSystem a
PrimMonad, Monad ParSystem
Monad ParSystem =>
(forall e a. (HasCallStack, Exception e) => e -> ParSystem a)
-> MonadThrow ParSystem
forall e a. (HasCallStack, Exception e) => e -> ParSystem a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> ParSystem a
throwM :: forall e a. (HasCallStack, Exception e) => e -> ParSystem a
MonadThrow)

class GetWorld a where
  getWorld :: a -> Hidden World

instance (GetWorld (Hidden World)) where
  getWorld :: Hidden World -> Hidden World
getWorld = Hidden World -> Hidden World
forall a. a -> a
id

instance (GetWorld ParWorld) where
  getWorld :: ParWorld -> Hidden World
getWorld !ParWorld
x = ParWorld
x.world

class SystemAny m where
  systemAny :: System a -> ParSystem a -> m a

instance SystemAny ParSystem where
  systemAny :: forall a. System a -> ParSystem a -> ParSystem a
systemAny System a
_ ParSystem a
a = ParSystem a
a

instance SystemAny System where
  systemAny :: forall a. System a -> ParSystem a -> System a
systemAny System a
a ParSystem a
_ = System a
a

-- | Typeclass that can be used to generalize systems to both @'System'@ and @'ParSystem'@.
--
-- Used mainly by queries and other operations which don't mutate the World.
class (GetWorld w, MonadReader w a, Applicative a, MonadFail a, Functor a, Monad a, MonadIO a, PrimMonad a, PrimState a ~ RealWorld, MonadThrow a, SystemAny a) => MonadSystem w a

instance MonadSystem (Hidden World) System

instance MonadSystem ParWorld ParSystem

-- Grab the World. DO NOT USE THIS.
unsafeGetWorld :: (MonadSystem w m) => m World
unsafeGetWorld :: forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld = do
  (w -> World) -> m World
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Hidden World -> World
forall a. Hidden a -> a
unhide (Hidden World -> World) -> (w -> Hidden World) -> w -> World
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Hidden World
forall a. GetWorld a => a -> Hidden World
getWorld)

instance EraseIntoStorage (System ()) [System ()] where
  erase :: System () -> [System ()]
  erase :: System () -> [System ()]
erase !System ()
x = [System ()
x]

data SystemTools = SystemTools
  { SystemTools
-> forall c (m :: * -> *) w.
   (MonadSystem w m, Component c) =>
   Proxy c -> Entity -> m (Maybe c)
get :: forall c m w. (MonadSystem w m, Component c) => Proxy c -> Entity -> m (Maybe c),
    SystemTools
-> forall c (m :: * -> *) w.
   (Component c, MonadSystem w m, IsExclusiveRel c ~ 'False) =>
   Proxy c -> Entity -> m (Maybe [Rel c])
getRAny :: forall c m w. (Component c, MonadSystem w m, IsExclusiveRel c ~ False) => Proxy c -> Entity -> m (Maybe [Rel c]),
    SystemTools -> forall c. Bundle c => c -> Entity -> System ()
set :: forall c. (Bundle c) => c -> Entity -> System (),
    SystemTools -> forall b. Bundle b => Entity -> b -> System ()
spawnByInsert :: forall b. (Bundle b) => Entity -> b -> System ()
  }

worldGet :: forall c m w. (MonadSystem w m, Component c) => Proxy c -> Entity -> m (Maybe c)
worldGet :: forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
Proxy c -> Entity -> m (Maybe c)
worldGet !Proxy c
p !Entity
e = do
  World {tools = SystemTools {get = !get}} <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  get p e

worldSet :: forall c. (Bundle c) => c -> Entity -> System ()
worldSet :: forall c. Bundle c => c -> Entity -> System ()
worldSet !c
c !Entity
e = do
  World {tools = SystemTools {set = !set}} <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  set c e

worldGetRAny :: forall c m w. (Component c, MonadSystem w m, IsExclusiveRel c ~ False) => Proxy c -> Entity -> m (Maybe [Rel c])
worldGetRAny :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m, IsExclusiveRel c ~ 'False) =>
Proxy c -> Entity -> m (Maybe [Rel c])
worldGetRAny !Proxy c
p !Entity
e = do
  World {tools = SystemTools {getRAny = !getRAny}} <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  getRAny p e

worldSpawnByInsert :: forall b. (Bundle b) => Entity -> b -> System ()
worldSpawnByInsert :: forall b. Bundle b => Entity -> b -> System ()
worldSpawnByInsert !Entity
e !b
b = do
  World {tools = SystemTools {spawnByInsert = !spawnByInsert}} <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  spawnByInsert e b

sysUnliftIO :: System (System a -> IO a)
sysUnliftIO :: forall a. System (System a -> IO a)
sysUnliftIO = do
  !world <- World -> Hidden World
forall a. a -> Hidden a
hide (World -> Hidden World) -> System World -> System (Hidden World)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  pure $ \(System !ReaderT (Hidden World) IO a
a) -> ReaderT (Hidden World) IO a -> Hidden World -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Hidden World) IO a
a Hidden World
world

-- | Primitive that allows you to set a system to run at every sync point until it returns a @Just a@, at which point
-- it will run the second system with the obtained @a@ and stop running.
--
-- It will run once on the spot, meaning it has no overhead if the first system immediately succeed.
--
-- You should only use this in one-time logic, such as Events or the Startup schedule. You should not use it
-- in logic that runs continuously, such as in Update, as it will keep queueing up a new system to check without removing the old one.
runWhen :: (Typeable a) => System (Maybe a) -> (a -> System b) -> System ()
runWhen :: forall a b.
Typeable a =>
System (Maybe a) -> (a -> System b) -> System ()
runWhen !System (Maybe a)
s1 !a -> System b
s2 = do
  b <- System (Maybe a)
s1
  case b of
    Just a
a -> System b -> System ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (System b -> System ()) -> System b -> System ()
forall a b. (a -> b) -> a -> b
$ a -> System b
s2 a
a
    Maybe a
Nothing -> do
      World {trySystems = !trySystems} <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
      liftIO $ modifyIORef' trySystems (++ [(fmap eraseValue <$> s1, void . s2 . unsafeUneraseValue)])

-- | Lift a ParSystem into a System. Doesn't flush the deferred queue!
parLift :: ParSystem a -> System a
parLift :: forall a. ParSystem a -> System a
parLift (ParSystem !ReaderT ParWorld IO a
p) = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  systems <- liftIO $ newIORef []
  a <- liftIO $ runReaderT p ParWorld {world = Hidden world, parDeferred = systems}
  systems <- liftIO $ readIORef systems
  liftIO $ modifyIORef' world.deferred (++ systems)
  pure a