{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- | This module contains STM-supporting versions of regular apecs stores, and some convenience functions. -- It is designed to be imported qualified, since it shadows both apecs and STM names. -- There is also an @Apecs.STM.Prelude@ module, which can be imported by itself. -- -- Note that if you want to be able to create entities in STM, you will also need to use a STM-supported @EntityCounter@, typically done through this module's @makeWorld@. module Apecs.STM ( -- * Stores Map (..) , Unique (..) , Global (..) -- * EntityCounter , EntityCounter (..) , nextEntity, newEntity, makeWorld, makeWorldAndComponents -- * STM conveniences , atomically, retry, check, forkSys, threadDelay, STM ) where import qualified Control.Concurrent as S import Control.Concurrent.STM (STM) import qualified Control.Concurrent.STM as S import Control.Concurrent.STM.TVar as S import Control.Monad import Data.Maybe import Data.Monoid (Sum (..)) import Data.Semigroup import Data.Typeable (Typeable, typeRep) import qualified Data.Vector.Unboxed as U import Language.Haskell.TH import qualified ListT as L import qualified StmContainers.Map as M import Apecs (ask, get, global, lift, liftIO, runSystem, set) import Apecs.Core import Apecs.TH (makeWorldNoEC, makeMapComponentsFor) newtype Map c = Map (M.Map Int c) type instance Elem (Map c) = c instance ExplInit STM (Map c) where explInit :: STM (Map c) explInit = Map Int c -> Map c forall c. Map Int c -> Map c Map (Map Int c -> Map c) -> STM (Map Int c) -> STM (Map c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> STM (Map Int c) forall key value. STM (Map key value) M.new instance Typeable c => ExplGet STM (Map c) where {-# INLINE explExists #-} {-# INLINE explGet #-} explExists :: Map c -> Int -> STM Bool explExists (Map Map Int c m) Int ety = Maybe c -> Bool forall a. Maybe a -> Bool isJust (Maybe c -> Bool) -> STM (Maybe c) -> STM Bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Int -> Map Int c -> STM (Maybe c) forall key value. (Eq key, Hashable key) => key -> Map key value -> STM (Maybe value) M.lookup Int ety Map Int c m explGet :: Map c -> Int -> STM (Elem (Map c)) explGet (Map Map Int c m) Int ety = ((Maybe c -> c) -> STM (Maybe c) -> STM c) -> STM (Maybe c) -> (Maybe c -> c) -> STM c forall a b c. (a -> b -> c) -> b -> a -> c flip (Maybe c -> c) -> STM (Maybe c) -> STM c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Int -> Map Int c -> STM (Maybe c) forall key value. (Eq key, Hashable key) => key -> Map key value -> STM (Maybe value) M.lookup Int ety Map Int c m) ((Maybe c -> c) -> STM c) -> (Maybe c -> c) -> STM c forall a b. (a -> b) -> a -> b $ \case Just c c -> c c Maybe c notFound -> [Char] -> c forall a. HasCallStack => [Char] -> a error ([Char] -> c) -> [Char] -> c forall a b. (a -> b) -> a -> b $ [[Char]] -> [Char] unwords [ [Char] "Reading non-existent STM Map component" , TypeRep -> [Char] forall a. Show a => a -> [Char] show (Maybe c -> TypeRep forall k (proxy :: k -> *) (a :: k). Typeable a => proxy a -> TypeRep typeRep Maybe c notFound) , [Char] "for entity" , Int -> [Char] forall a. Show a => a -> [Char] show Int ety ] instance ExplSet STM (Map c) where {-# INLINE explSet #-} explSet :: Map c -> Int -> Elem (Map c) -> STM () explSet (Map Map Int c m) Int ety Elem (Map c) x = c -> Int -> Map Int c -> STM () forall key value. (Eq key, Hashable key) => value -> key -> Map key value -> STM () M.insert c Elem (Map c) x Int ety Map Int c m instance ExplDestroy STM (Map c) where {-# INLINE explDestroy #-} explDestroy :: Map c -> Int -> STM () explDestroy (Map Map Int c m) Int ety = Int -> Map Int c -> STM () forall key value. (Eq key, Hashable key) => key -> Map key value -> STM () M.delete Int ety Map Int c m instance ExplMembers STM (Map c) where {-# INLINE explMembers #-} explMembers :: Map c -> STM (Vector Int) explMembers (Map Map Int c m) = (ListT STM Int -> STM (Maybe (Int, ListT STM Int))) -> ListT STM Int -> STM (Vector Int) forall (m :: * -> *) a b. (Monad m, Unbox a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) U.unfoldrM ListT STM Int -> STM (Maybe (Int, ListT STM Int)) forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a)) L.uncons (ListT STM Int -> STM (Vector Int)) -> ListT STM Int -> STM (Vector Int) forall a b. (a -> b) -> a -> b $ (Int, c) -> Int forall a b. (a, b) -> a fst ((Int, c) -> Int) -> ListT STM (Int, c) -> ListT STM Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Map Int c -> ListT STM (Int, c) forall key value. Map key value -> ListT STM (key, value) M.listT Map Int c m instance ExplInit IO (Map c) where {-# INLINE explInit #-} explInit :: IO (Map c) explInit = STM (Map c) -> IO (Map c) forall a. STM a -> IO a S.atomically STM (Map c) forall (m :: * -> *) s. ExplInit m s => m s explInit instance Typeable c => ExplGet IO (Map c) where {-# INLINE explExists #-} {-# INLINE explGet #-} explExists :: Map c -> Int -> IO Bool explExists Map c m Int e = STM Bool -> IO Bool forall a. STM a -> IO a S.atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Map c -> Int -> STM Bool forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool explExists Map c m Int e explGet :: Map c -> Int -> IO (Elem (Map c)) explGet Map c m Int e = STM c -> IO c forall a. STM a -> IO a S.atomically (STM c -> IO c) -> STM c -> IO c forall a b. (a -> b) -> a -> b $ Map c -> Int -> STM (Elem (Map c)) forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s) explGet Map c m Int e instance ExplSet IO (Map c) where {-# INLINE explSet #-} explSet :: Map c -> Int -> Elem (Map c) -> IO () explSet Map c m Int e Elem (Map c) x = STM () -> IO () forall a. STM a -> IO a S.atomically (STM () -> IO ()) -> STM () -> IO () forall a b. (a -> b) -> a -> b $ Map c -> Int -> Elem (Map c) -> STM () forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m () explSet Map c m Int e Elem (Map c) x instance ExplDestroy IO (Map c) where {-# INLINE explDestroy #-} explDestroy :: Map c -> Int -> IO () explDestroy Map c m Int e = STM () -> IO () forall a. STM a -> IO a S.atomically (STM () -> IO ()) -> STM () -> IO () forall a b. (a -> b) -> a -> b $ Map c -> Int -> STM () forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m () explDestroy Map c m Int e instance ExplMembers IO (Map c) where {-# INLINE explMembers #-} explMembers :: Map c -> IO (Vector Int) explMembers Map c m = STM (Vector Int) -> IO (Vector Int) forall a. STM a -> IO a S.atomically (STM (Vector Int) -> IO (Vector Int)) -> STM (Vector Int) -> IO (Vector Int) forall a b. (a -> b) -> a -> b $ Map c -> STM (Vector Int) forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int) explMembers Map c m newtype Unique c = Unique (TVar (Maybe (Int, c))) type instance Elem (Unique c) = c instance ExplInit STM (Unique c) where explInit :: STM (Unique c) explInit = TVar (Maybe (Int, c)) -> Unique c forall c. TVar (Maybe (Int, c)) -> Unique c Unique (TVar (Maybe (Int, c)) -> Unique c) -> STM (TVar (Maybe (Int, c))) -> STM (Unique c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (Int, c) -> STM (TVar (Maybe (Int, c))) forall a. a -> STM (TVar a) newTVar Maybe (Int, c) forall a. Maybe a Nothing instance Typeable c => ExplGet STM (Unique c) where {-# INLINE explGet #-} explGet :: Unique c -> Int -> STM (Elem (Unique c)) explGet (Unique TVar (Maybe (Int, c)) ref) Int _ = ((Maybe (Int, c) -> c) -> STM (Maybe (Int, c)) -> STM c) -> STM (Maybe (Int, c)) -> (Maybe (Int, c) -> c) -> STM c forall a b c. (a -> b -> c) -> b -> a -> c flip (Maybe (Int, c) -> c) -> STM (Maybe (Int, c)) -> STM c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (TVar (Maybe (Int, c)) -> STM (Maybe (Int, c)) forall a. TVar a -> STM a readTVar TVar (Maybe (Int, c)) ref) ((Maybe (Int, c) -> c) -> STM c) -> (Maybe (Int, c) -> c) -> STM c forall a b. (a -> b) -> a -> b $ \case Just (Int _, c c) -> c c Maybe (Int, c) notFound -> [Char] -> c forall a. HasCallStack => [Char] -> a error ([Char] -> c) -> [Char] -> c forall a b. (a -> b) -> a -> b $ [[Char]] -> [Char] unwords [ [Char] "Reading non-existent STM Unique component" , TypeRep -> [Char] forall a. Show a => a -> [Char] show (Maybe (Int, c) -> TypeRep forall k (proxy :: k -> *) (a :: k). Typeable a => proxy a -> TypeRep typeRep Maybe (Int, c) notFound) ] {-# INLINE explExists #-} explExists :: Unique c -> Int -> STM Bool explExists (Unique TVar (Maybe (Int, c)) ref) Int ety = Bool -> ((Int, c) -> Bool) -> Maybe (Int, c) -> Bool forall b a. b -> (a -> b) -> Maybe a -> b maybe Bool False ((Int -> Int -> Bool forall a. Eq a => a -> a -> Bool ==Int ety) (Int -> Bool) -> ((Int, c) -> Int) -> (Int, c) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int, c) -> Int forall a b. (a, b) -> a fst) (Maybe (Int, c) -> Bool) -> STM (Maybe (Int, c)) -> STM Bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TVar (Maybe (Int, c)) -> STM (Maybe (Int, c)) forall a. TVar a -> STM a readTVar TVar (Maybe (Int, c)) ref instance ExplSet STM (Unique c) where {-# INLINE explSet #-} explSet :: Unique c -> Int -> Elem (Unique c) -> STM () explSet (Unique TVar (Maybe (Int, c)) ref) Int ety Elem (Unique c) c = TVar (Maybe (Int, c)) -> Maybe (Int, c) -> STM () forall a. TVar a -> a -> STM () writeTVar TVar (Maybe (Int, c)) ref ((Int, c) -> Maybe (Int, c) forall a. a -> Maybe a Just (Int ety, c Elem (Unique c) c)) instance ExplDestroy STM (Unique c) where {-# INLINE explDestroy #-} explDestroy :: Unique c -> Int -> STM () explDestroy (Unique TVar (Maybe (Int, c)) ref) Int ety = TVar (Maybe (Int, c)) -> STM (Maybe (Int, c)) forall a. TVar a -> STM a readTVar TVar (Maybe (Int, c)) ref STM (Maybe (Int, c)) -> (Maybe (Int, c) -> STM ()) -> STM () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= ((Int, c) -> STM ()) -> Maybe (Int, c) -> STM () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ ((Bool -> STM () -> STM ()) -> STM () -> Bool -> STM () forall a b c. (a -> b -> c) -> b -> a -> c flip Bool -> STM () -> STM () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (TVar (Maybe (Int, c)) -> Maybe (Int, c) -> STM () forall a. TVar a -> a -> STM () writeTVar TVar (Maybe (Int, c)) ref Maybe (Int, c) forall a. Maybe a Nothing) (Bool -> STM ()) -> ((Int, c) -> Bool) -> (Int, c) -> STM () forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int -> Int -> Bool forall a. Eq a => a -> a -> Bool ==Int ety) (Int -> Bool) -> ((Int, c) -> Int) -> (Int, c) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int, c) -> Int forall a b. (a, b) -> a fst) instance ExplMembers STM (Unique c) where {-# INLINE explMembers #-} explMembers :: Unique c -> STM (Vector Int) explMembers (Unique TVar (Maybe (Int, c)) ref) = ((Maybe (Int, c) -> Vector Int) -> STM (Maybe (Int, c)) -> STM (Vector Int)) -> STM (Maybe (Int, c)) -> (Maybe (Int, c) -> Vector Int) -> STM (Vector Int) forall a b c. (a -> b -> c) -> b -> a -> c flip (Maybe (Int, c) -> Vector Int) -> STM (Maybe (Int, c)) -> STM (Vector Int) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (TVar (Maybe (Int, c)) -> STM (Maybe (Int, c)) forall a. TVar a -> STM a readTVar TVar (Maybe (Int, c)) ref) ((Maybe (Int, c) -> Vector Int) -> STM (Vector Int)) -> (Maybe (Int, c) -> Vector Int) -> STM (Vector Int) forall a b. (a -> b) -> a -> b $ \case Maybe (Int, c) Nothing -> Vector Int forall a. Monoid a => a mempty Just (Int ety, c _) -> Int -> Vector Int forall a. Unbox a => a -> Vector a U.singleton Int ety instance ExplInit IO (Unique c) where {-# INLINE explInit #-} explInit :: IO (Unique c) explInit = STM (Unique c) -> IO (Unique c) forall a. STM a -> IO a S.atomically STM (Unique c) forall (m :: * -> *) s. ExplInit m s => m s explInit instance Typeable c => ExplGet IO (Unique c) where {-# INLINE explExists #-} explExists :: Unique c -> Int -> IO Bool explExists Unique c m Int e = STM Bool -> IO Bool forall a. STM a -> IO a S.atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Unique c -> Int -> STM Bool forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool explExists Unique c m Int e {-# INLINE explGet #-} explGet :: Unique c -> Int -> IO (Elem (Unique c)) explGet Unique c m Int e = STM c -> IO c forall a. STM a -> IO a S.atomically (STM c -> IO c) -> STM c -> IO c forall a b. (a -> b) -> a -> b $ Unique c -> Int -> STM (Elem (Unique c)) forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s) explGet Unique c m Int e instance ExplSet IO (Unique c) where {-# INLINE explSet #-} explSet :: Unique c -> Int -> Elem (Unique c) -> IO () explSet Unique c m Int e Elem (Unique c) x = STM () -> IO () forall a. STM a -> IO a S.atomically (STM () -> IO ()) -> STM () -> IO () forall a b. (a -> b) -> a -> b $ Unique c -> Int -> Elem (Unique c) -> STM () forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m () explSet Unique c m Int e Elem (Unique c) x instance ExplDestroy IO (Unique c) where {-# INLINE explDestroy #-} explDestroy :: Unique c -> Int -> IO () explDestroy Unique c m Int e = STM () -> IO () forall a. STM a -> IO a S.atomically (STM () -> IO ()) -> STM () -> IO () forall a b. (a -> b) -> a -> b $ Unique c -> Int -> STM () forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m () explDestroy Unique c m Int e instance ExplMembers IO (Unique c) where {-# INLINE explMembers #-} explMembers :: Unique c -> IO (Vector Int) explMembers Unique c m = STM (Vector Int) -> IO (Vector Int) forall a. STM a -> IO a S.atomically (STM (Vector Int) -> IO (Vector Int)) -> STM (Vector Int) -> IO (Vector Int) forall a b. (a -> b) -> a -> b $ Unique c -> STM (Vector Int) forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int) explMembers Unique c m newtype Global c = Global (TVar c) type instance Elem (Global c) = c instance Monoid c => ExplInit STM (Global c) where {-# INLINE explInit #-} explInit :: STM (Global c) explInit = TVar c -> Global c forall c. TVar c -> Global c Global (TVar c -> Global c) -> STM (TVar c) -> STM (Global c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> c -> STM (TVar c) forall a. a -> STM (TVar a) newTVar c forall a. Monoid a => a mempty instance ExplGet STM (Global c) where {-# INLINE explGet #-} explGet :: Global c -> Int -> STM (Elem (Global c)) explGet (Global TVar c ref) Int _ = TVar c -> STM c forall a. TVar a -> STM a readTVar TVar c ref {-# INLINE explExists #-} explExists :: Global c -> Int -> STM Bool explExists Global c _ Int _ = Bool -> STM Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool True instance ExplSet STM (Global c) where {-# INLINE explSet #-} explSet :: Global c -> Int -> Elem (Global c) -> STM () explSet (Global TVar c ref) Int _ Elem (Global c) c = TVar c -> c -> STM () forall a. TVar a -> a -> STM () writeTVar TVar c ref c Elem (Global c) c instance Monoid c => ExplInit IO (Global c) where {-# INLINE explInit #-} explInit :: IO (Global c) explInit = STM (Global c) -> IO (Global c) forall a. STM a -> IO a S.atomically STM (Global c) forall (m :: * -> *) s. ExplInit m s => m s explInit instance ExplGet IO (Global c) where {-# INLINE explExists #-} explExists :: Global c -> Int -> IO Bool explExists Global c m Int e = STM Bool -> IO Bool forall a. STM a -> IO a S.atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Global c -> Int -> STM Bool forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool explExists Global c m Int e {-# INLINE explGet #-} explGet :: Global c -> Int -> IO (Elem (Global c)) explGet Global c m Int e = STM c -> IO c forall a. STM a -> IO a S.atomically (STM c -> IO c) -> STM c -> IO c forall a b. (a -> b) -> a -> b $ Global c -> Int -> STM (Elem (Global c)) forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s) explGet Global c m Int e instance ExplSet IO (Global c) where {-# INLINE explSet #-} explSet :: Global c -> Int -> Elem (Global c) -> IO () explSet Global c m Int e Elem (Global c) x = STM () -> IO () forall a. STM a -> IO a S.atomically (STM () -> IO ()) -> STM () -> IO () forall a b. (a -> b) -> a -> b $ Global c -> Int -> Elem (Global c) -> STM () forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m () explSet Global c m Int e Elem (Global c) x newtype EntityCounter = EntityCounter {EntityCounter -> Sum Int getCounter :: Sum Int} deriving (b -> EntityCounter -> EntityCounter NonEmpty EntityCounter -> EntityCounter EntityCounter -> EntityCounter -> EntityCounter (EntityCounter -> EntityCounter -> EntityCounter) -> (NonEmpty EntityCounter -> EntityCounter) -> (forall b. Integral b => b -> EntityCounter -> EntityCounter) -> Semigroup EntityCounter forall b. Integral b => b -> EntityCounter -> EntityCounter forall a. (a -> a -> a) -> (NonEmpty a -> a) -> (forall b. Integral b => b -> a -> a) -> Semigroup a stimes :: b -> EntityCounter -> EntityCounter $cstimes :: forall b. Integral b => b -> EntityCounter -> EntityCounter sconcat :: NonEmpty EntityCounter -> EntityCounter $csconcat :: NonEmpty EntityCounter -> EntityCounter <> :: EntityCounter -> EntityCounter -> EntityCounter $c<> :: EntityCounter -> EntityCounter -> EntityCounter Semigroup, Semigroup EntityCounter EntityCounter Semigroup EntityCounter -> EntityCounter -> (EntityCounter -> EntityCounter -> EntityCounter) -> ([EntityCounter] -> EntityCounter) -> Monoid EntityCounter [EntityCounter] -> EntityCounter EntityCounter -> EntityCounter -> EntityCounter forall a. Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a mconcat :: [EntityCounter] -> EntityCounter $cmconcat :: [EntityCounter] -> EntityCounter mappend :: EntityCounter -> EntityCounter -> EntityCounter $cmappend :: EntityCounter -> EntityCounter -> EntityCounter mempty :: EntityCounter $cmempty :: EntityCounter $cp1Monoid :: Semigroup EntityCounter Monoid, EntityCounter -> EntityCounter -> Bool (EntityCounter -> EntityCounter -> Bool) -> (EntityCounter -> EntityCounter -> Bool) -> Eq EntityCounter forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: EntityCounter -> EntityCounter -> Bool $c/= :: EntityCounter -> EntityCounter -> Bool == :: EntityCounter -> EntityCounter -> Bool $c== :: EntityCounter -> EntityCounter -> Bool Eq, Int -> EntityCounter -> ShowS [EntityCounter] -> ShowS EntityCounter -> [Char] (Int -> EntityCounter -> ShowS) -> (EntityCounter -> [Char]) -> ([EntityCounter] -> ShowS) -> Show EntityCounter forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [EntityCounter] -> ShowS $cshowList :: [EntityCounter] -> ShowS show :: EntityCounter -> [Char] $cshow :: EntityCounter -> [Char] showsPrec :: Int -> EntityCounter -> ShowS $cshowsPrec :: Int -> EntityCounter -> ShowS Show) instance Component EntityCounter where type Storage EntityCounter = Global EntityCounter {-# INLINE nextEntity #-} nextEntity :: (Get w m EntityCounter, Set w m EntityCounter) => SystemT w m Entity nextEntity :: SystemT w m Entity nextEntity = do EntityCounter Sum Int n <- Entity -> SystemT w m EntityCounter forall w (m :: * -> *) c. Get w m c => Entity -> SystemT w m c get Entity global Entity -> EntityCounter -> SystemT w m () forall w (m :: * -> *) c. Set w m c => Entity -> c -> SystemT w m () set Entity global (Sum Int -> EntityCounter EntityCounter (Sum Int -> EntityCounter) -> Sum Int -> EntityCounter forall a b. (a -> b) -> a -> b $ Sum Int nSum Int -> Sum Int -> Sum Int forall a. Num a => a -> a -> a +Sum Int 1) Entity -> SystemT w m Entity forall (m :: * -> *) a. Monad m => a -> m a return (Int -> Entity Entity (Int -> Entity) -> (Sum Int -> Int) -> Sum Int -> Entity forall b c a. (b -> c) -> (a -> b) -> a -> c . Sum Int -> Int forall a. Sum a -> a getSum (Sum Int -> Entity) -> Sum Int -> Entity forall a b. (a -> b) -> a -> b $ Sum Int n) {-# INLINE newEntity #-} newEntity :: (Set w m c, Get w m EntityCounter, Set w m EntityCounter) => c -> SystemT w m Entity newEntity :: c -> SystemT w m Entity newEntity c c = do Entity ety <- SystemT w m Entity forall w (m :: * -> *). (Get w m EntityCounter, Set w m EntityCounter) => SystemT w m Entity nextEntity Entity -> c -> SystemT w m () forall w (m :: * -> *) c. Set w m c => Entity -> c -> SystemT w m () set Entity ety c c Entity -> SystemT w m Entity forall (m :: * -> *) a. Monad m => a -> m a return Entity ety -- | Like @makeWorld@ from @Apecs@, but uses the STM @EntityCounter@ makeWorld :: String -> [Name] -> Q [Dec] makeWorld :: [Char] -> [Name] -> Q [Dec] makeWorld [Char] worldName [Name] cTypes = [Char] -> [Name] -> Q [Dec] makeWorldNoEC [Char] worldName ([Name] cTypes [Name] -> [Name] -> [Name] forall a. [a] -> [a] -> [a] ++ [''EntityCounter]) -- | Like @makeWorldAndComponents@ from @Apecs@, but uses the STM @EntityCounter@ and the STM @Map@ makeWorldAndComponents :: String -> [Name] -> Q [Dec] makeWorldAndComponents :: [Char] -> [Name] -> Q [Dec] makeWorldAndComponents [Char] worldName [Name] cTypes = do [Dec] wdecls <- [Char] -> [Name] -> Q [Dec] makeWorld [Char] worldName [Name] cTypes [Dec] cdecls <- Name -> [Name] -> Q [Dec] makeMapComponentsFor ''Map [Name] cTypes [Dec] -> Q [Dec] forall (f :: * -> *) a. Applicative f => a -> f a pure ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec] forall a b. (a -> b) -> a -> b $ [Dec] wdecls [Dec] -> [Dec] -> [Dec] forall a. [a] -> [a] -> [a] ++ [Dec] cdecls -- | @atomically@ from STM, lifted to the System level. atomically :: SystemT w STM a -> SystemT w IO a atomically :: SystemT w STM a -> SystemT w IO a atomically SystemT w STM a sys = SystemT w IO w forall r (m :: * -> *). MonadReader r m => m r ask SystemT w IO w -> (w -> SystemT w IO a) -> SystemT w IO a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= IO a -> SystemT w IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO a -> SystemT w IO a) -> (w -> IO a) -> w -> SystemT w IO a forall b c a. (b -> c) -> (a -> b) -> a -> c . STM a -> IO a forall a. STM a -> IO a S.atomically (STM a -> IO a) -> (w -> STM a) -> w -> IO a forall b c a. (b -> c) -> (a -> b) -> a -> c . SystemT w STM a -> w -> STM a forall w (m :: * -> *) a. SystemT w m a -> w -> m a runSystem SystemT w STM a sys -- | @retry@ from STM, lifted to the System level. retry :: SystemT w STM a retry :: SystemT w STM a retry = STM a -> SystemT w STM a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift STM a forall a. STM a S.retry -- | @check@ from STM, lifted to the System level. check :: Bool -> SystemT w STM () check :: Bool -> SystemT w STM () check = STM () -> SystemT w STM () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (STM () -> SystemT w STM ()) -> (Bool -> STM ()) -> Bool -> SystemT w STM () forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> STM () S.check -- | Runs a system on a new thread. forkSys :: SystemT w IO () -> SystemT w IO S.ThreadId forkSys :: SystemT w IO () -> SystemT w IO ThreadId forkSys SystemT w IO () sys = SystemT w IO w forall r (m :: * -> *). MonadReader r m => m r ask SystemT w IO w -> (w -> SystemT w IO ThreadId) -> SystemT w IO ThreadId forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= IO ThreadId -> SystemT w IO ThreadId forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO ThreadId -> SystemT w IO ThreadId) -> (w -> IO ThreadId) -> w -> SystemT w IO ThreadId forall b c a. (b -> c) -> (a -> b) -> a -> c . IO () -> IO ThreadId S.forkIO (IO () -> IO ThreadId) -> (w -> IO ()) -> w -> IO ThreadId forall b c a. (b -> c) -> (a -> b) -> a -> c . SystemT w IO () -> w -> IO () forall w (m :: * -> *) a. SystemT w m a -> w -> m a runSystem SystemT w IO () sys -- | Suspends the current thread for a number of microseconds. threadDelay :: Int -> SystemT w IO () threadDelay :: Int -> SystemT w IO () threadDelay = IO () -> SystemT w IO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> SystemT w IO ()) -> (Int -> IO ()) -> Int -> SystemT w IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> IO () S.threadDelay