apecs 0.6.0.0 → 0.7.0

raw patch · 13 files changed

+597/−329 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• README.md +14/−20
• apecs.cabal +4/−2
• src/Apecs.hs +1/−0
• src/Apecs/Components.hs +218/−0
• src/Apecs/Core.hs +4/−188
• src/Apecs/Reactive.hs +131/−0
• src/Apecs/Stores.hs +52/−103
• src/Apecs/Stores/Extra.hs +145/−0
• src/Apecs/System.hs +1/−2
• src/Apecs/TH.hs +2/−1
• src/Apecs/Util.hs +5/−4
• test/Main.hs +9/−9

@@ -1,3 +1,14 @@+## [0.6.1]+### Added+- The `Reactive` store and module is a redesign of the `Register` store, and provides a more general solution for 'stores that perform additional actions when written to'.+- The `Apecs.Stores.Extra` submodule, which contains the `Pushdown` and `ReadOnly` stores. `Pushdown` adds pushdown semantics to stores, and `ReadOnly` hides the `ExplSet` instances of whatever it wraps.+- The `EntityCounter` and associated functions have all been specified to `IO`, since `Global EntityCounter` only works in IO. Furthermore, `EntityCounter` now uses a `ReadOnly` store, to prevent users from accidentally changing its value.+- `Redirect` component that writes to another entity in `cmap`.+### Changed+- Default stores have `MonadIO m => m` instances, rather than `IO`. This makes it easier to nest `SystemT`.+- All apecs packages have been consolidated into a single git repo.+- `Apecs.Components` contains the components (and corresponding stores) from `Apecs.Core`.+ ## [0.6.0.0] ### Changed - Nothing, but since 0.5.1 was API-breaking I've decided to bump to 0.6

@@ -1,11 +1,12 @@ # apecs-[![Build Status](https://travis-ci.org/jonascarpay/apecs.svg?branch=master)](https://travis-ci.org/jonascarpay/apecs)-[![Hackage](https://img.shields.io/hackage/v/apecs.svg)](https://hackage.haskell.org/package/apecs)-[![Stackage](https://www.stackage.org/package/apecs/badge/lts?label=Stackage)](https://www.stackage.org/package/apecs)  apecs is an _Entity Component System_ (ECS) framework inspired by [specs](https://github.com/slide-rs/specs) and [Entitas](https://github.com/sschmid/Entitas-CSharp). ECS presents a data-driven approach to game development, that elegantly tackles many of the unique issues of game programming.-The apecs front-end DSL exposes a small number of combinators that allow game logic to be expressive and extremely fast.+apecs aims to be+* **Fast** - apecs is designed for high-performance applications. Its performance is competitive with Rust ECS libraries.+* **Simple** - Game logic is expressed using a small number of combinators, and minimal boilerplate.+* **Safe** - The `cmap`/`cfold`-DSL hides all the dangers of the low-level API.+* **Extensible** - apecs can be used with anything that implements the low-level API. See [apecs-physics](apecs-physics/) or [apecs-stm](apecs-stm/) for examples.  #### Links - [manual](https://github.com/jonascarpay/apecs/blob/master/prepub.pdf) (see [#19](https://github.com/jonascarpay/apecs/issues/19))@@ -16,29 +17,22 @@ #### Performance [ecs-bench](https://github.com/lschmierer/ecs_bench) shows that apecs is competitive with the fastest Rust ECS frameworks. -![Benchmarks](/bench/chart.png)+![Benchmarks](bench/chart.png)  #### Example ```haskell-{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeFamilies, MultiParamTypeClasses, TemplateHaskell #-}+{-# LANGUAGE DataKinds, FlexibleInstances, ScopedTypeVariables, TypeFamilies, MultiParamTypeClasses, TemplateHaskell #-}  import Apecs+import Control.Monad+import Apecs.Util import Linear (V2 (..))  newtype Position = Position (V2 Double) deriving Show--- To declare a component, we need to specify how to store it-instance Component Position where-  type Storage Position = Map Position -- The simplest store is a Map- newtype Velocity = Velocity (V2 Double) deriving Show-instance Component Velocity where-  type Storage Velocity = Cache 100 (Map Velocity) -- Caching adds fast reads/writes- data Flying = Flying-instance Component Flying where-  type Storage Flying = Map Flying -makeWorld "World" [''Position, ''Velocity, ''Flying] -- Generate World and instances+makeWorldAndComponents "World" [''Position, ''Velocity, ''Flying]  game :: System World () game = do@@ -46,11 +40,11 @@   newEntity (Position 2, Velocity 1)   newEntity (Position 1, Velocity 2, Flying) -  -- Add velocity to position+  -- 1. Add velocity to position+  -- 2. Apply gravity to non-flying entities+  -- 3. Print a list of entities and their positions   cmap $ \(Position p, Velocity v) -> Position (v+p)-  -- Apply gravity to non-flying entities-  cmap $ \(Velocity v, _ :: Not Flying) -> Velocity (v - (V2 0 1))-  -- Print a list of entities and their positions+  cmap $ \(Velocity v, _ :: Not Flying) -> Velocity (v - V2 0 1)   cmapM_ $ \(Position p, Entity e) -> liftIO . print $ (e, p)  main :: IO ()

@@ -1,5 +1,5 @@ name:                apecs-version:             0.6.0.0+version:             0.7.0 homepage:            https://github.com/jonascarpay/apecs#readme license:             BSD3 license-file:        LICENSE@@ -27,7 +27,10 @@   exposed-modules:     Apecs,     Apecs.Core,+    Apecs.Components,     Apecs.Stores,+    Apecs.Stores.Extra,+    Apecs.Reactive,     Apecs.System,     Apecs.TH,     Apecs.Util@@ -43,7 +46,6 @@     vector   ghc-options:     -Wall-    -O2  test-suite apecs-test   type:

@@ -31,6 +31,7 @@ import           Data.Proxy  import           Apecs.Stores+import           Apecs.Components import           Apecs.System import           Apecs.TH import           Apecs.Core

@@ -0,0 +1,218 @@+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE TypeFamilies               #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module Apecs.Components where++import           Data.Functor.Identity++import           Apecs.Core+import qualified Apecs.THTuples        as T++-- | Identity component. @Identity c@ is equivalent to @c@, so mostly useless.+instance Component c => Component (Identity c) where+  type Storage (Identity c) = Identity (Storage c)++instance Has w m c => Has w m (Identity c) where+  {-# INLINE getStore #-}+  getStore = Identity <$> getStore++type instance Elem (Identity s) = Identity (Elem s)++instance ExplGet m s => ExplGet m (Identity s) where+  {-# INLINE explGet #-}+  explGet (Identity s) e = Identity <$> explGet s e+  {-# INLINE explExists  #-}+  explExists  (Identity s) = explExists s++instance ExplSet m s => ExplSet m (Identity s) where+  {-# INLINE explSet #-}+  explSet (Identity s) e (Identity x) = explSet s e x+instance ExplMembers m s => ExplMembers m (Identity s) where+  {-# INLINE explMembers #-}+  explMembers (Identity s) = explMembers s+instance ExplDestroy m s => ExplDestroy m (Identity s) where+  {-# INLINE explDestroy #-}+  explDestroy (Identity s) = explDestroy s++T.makeInstances [2..8]++-- | Psuedocomponent indicating the absence of @a@.+--   Mainly used as e.g. @cmap $ \(a, Not b) -> c@ to iterate over entities with an @a@ but no @b@.+--   Can also be used to delete components, like @cmap $ \a -> (Not :: Not a)@ to delete every @a@ component.+data Not a = Not++-- | Pseudostore used to produce values of type @Not a@, inverts @explExists@, and destroys instead of @explSet@.+newtype NotStore s = NotStore s++instance Component c => Component (Not c) where+  type Storage (Not c) = NotStore (Storage c)++instance (Has w m c) => Has w m (Not c) where+  {-# INLINE getStore #-}+  getStore = NotStore <$> getStore++type instance Elem (NotStore s) = Not (Elem s)++instance ExplGet m s => ExplGet m (NotStore s) where+  {-# INLINE explGet #-}+  explGet _ _ = return Not+  {-# INLINE explExists #-}+  explExists (NotStore sa) ety = not <$> explExists sa ety++instance ExplDestroy m s => ExplSet m (NotStore s) where+  {-# INLINE explSet #-}+  explSet (NotStore sa) ety _ = explDestroy sa ety++-- | Pseudostore used to produce values of type @Maybe a@.+--   Will always return @True@ for @explExists@.+--   Writing can both set and delete a component using @Just@ and @Nothing@ respectively.+newtype MaybeStore s = MaybeStore s+instance Component c => Component (Maybe c) where+  type Storage (Maybe c) = MaybeStore (Storage c)++instance (Has w m c) => Has w m (Maybe c) where+  {-# INLINE getStore #-}+  getStore = MaybeStore <$> getStore++type instance Elem (MaybeStore s) = Maybe (Elem s)++instance ExplGet m s => ExplGet m (MaybeStore s) where+  {-# INLINE explGet #-}+  explGet (MaybeStore sa) ety = do+    e <- explExists sa ety+    if e then Just <$> explGet sa ety+         else return Nothing+  explExists _ _ = return True++instance (ExplDestroy m s, ExplSet m s) => ExplSet m (MaybeStore s) where+  {-# INLINE explSet #-}+  explSet (MaybeStore sa) ety Nothing  = explDestroy sa ety+  explSet (MaybeStore sa) ety (Just x) = explSet sa ety x++-- | Used for 'Either', a logical disjunction between two components.+--   As expected, Either is used to model error values.+-- Getting an @Either a b@ will first attempt to get a @b@ and return it as @Right b@, or if it does not exist, get an @a@ as @Left a@.+-- Can also be used to set one of two things.+data EitherStore sa sb = EitherStore sa sb+instance (Component ca, Component cb) => Component (Either ca cb) where+  type Storage (Either ca cb) = EitherStore (Storage ca) (Storage cb)++instance (Has w m ca, Has w m cb) => Has w m (Either ca cb) where+  {-# INLINE getStore #-}+  getStore = EitherStore <$> getStore <*> getStore++type instance Elem (EitherStore sa sb) = Either (Elem sa) (Elem sb)++instance (ExplGet m sa, ExplGet m sb) => ExplGet m (EitherStore sa sb) where+  {-# INLINE explGet #-}+  explGet (EitherStore sa sb) ety = do+    e <- explExists sb ety+    if e then Right <$> explGet sb ety+         else Left <$> explGet sa ety+  {-# INLINE explExists #-}+  explExists (EitherStore sa sb) ety = do+    e <- explExists sb ety+    if e then return True+         else explExists sa ety++instance (ExplSet m sa, ExplSet m sb) => ExplSet m (EitherStore sa sb) where+  {-# INLINE explSet #-}+  explSet (EitherStore _ sb) ety (Right b) = explSet sb ety b+  explSet (EitherStore sa _) ety (Left a)  = explSet sa ety a++instance (ExplDestroy m sa, ExplDestroy m sb)+       => ExplDestroy m (EitherStore sa sb) where+  {-# INLINE explDestroy #-}+  explDestroy (EitherStore sa sb) ety =+    explDestroy sa ety >> explDestroy sb ety++-- Unit instances ()+instance Monad m => Has w m () where+  {-# INLINE getStore #-}+  getStore = return ()+instance Component () where+  type Storage () = ()+type instance Elem () = ()+instance Monad m => ExplGet m () where+  {-# INLINE explExists #-}+  explExists _ _ = return True+  {-# INLINE explGet #-}+  explGet _ _ = return ()+instance Monad m => ExplSet m () where+  {-# INLINE explSet #-}+  explSet _ _ _ = return ()+instance Monad m => ExplDestroy m () where+  {-# INLINE explDestroy #-}+  explDestroy _ _ = return ()++-- | Pseudocomponent that functions normally for @explExists@ and @explMembers@, but always return @Filter@ for @explGet@.+--   Can be used in cmap as @cmap $ \(Filter :: Filter a) -> b@.+--   Since the above can be written more consicely as @cmap $ \(_ :: a) -> b@, it is rarely directly.+--   More interestingly, we can define reusable filters like @movables = Filter :: Filter (Position, Velocity)@.+--   Note that 'Filter c' is equivalent to 'Not (Not c)'.+data Filter c = Filter deriving (Eq, Show)++-- Pseudostore for 'Filter'.+newtype FilterStore s = FilterStore s++instance Component c => Component (Filter c) where+  type Storage (Filter c) = FilterStore (Storage c)++instance Has w m c => Has w m (Filter c) where+  {-# INLINE getStore #-}+  getStore = FilterStore <$> getStore++type instance Elem (FilterStore s) = Filter (Elem s)++instance ExplGet m s => ExplGet m (FilterStore s) where+  {-# INLINE explGet #-}+  explGet _ _ = return Filter+  {-# INLINE explExists #-}+  explExists (FilterStore s) ety = explExists s ety++instance ExplMembers m s => ExplMembers m (FilterStore s) where+  {-# INLINE explMembers #-}+  explMembers (FilterStore s) = explMembers s++-- | Pseudostore used to produce components of type 'Entity'.+-- Always returns @True@ for @explExists@, and echoes back the entity argument for @explGet@.+-- Used in e.g. @cmap $ \(a, ety :: Entity) -> b@ to access the current entity.+data EntityStore = EntityStore+instance Component Entity where+  type Storage Entity = EntityStore++instance Monad m => Has w m Entity where+  {-# INLINE getStore #-}+  getStore = return EntityStore++type instance Elem EntityStore = Entity+instance Monad m => ExplGet m EntityStore where+  {-# INLINE explGet #-}+  explGet _ ety = return $ Entity ety+  {-# INLINE explExists #-}+  explExists _ _ = return True++-- | Pseudocomponent that when written to, actually writes 'c' to its entity argument.+--   Used to dereference during a @cmap@.+data Redirect c = Redirect Entity c deriving (Eq, Show)+instance Component c => Component (Redirect c) where+  type Storage (Redirect c) = RedirectStore (Storage c)++newtype RedirectStore s = RedirectStore s+type instance Elem (RedirectStore s) = Redirect (Elem s)++instance Has w m c => Has w m (Redirect c) where+  getStore = RedirectStore <$> getStore++instance (ExplSet m s) => ExplSet m (RedirectStore s) where+  explSet (RedirectStore s) _ (Redirect (Entity ety) c) = explSet s ety c

@@ -12,23 +12,20 @@ module Apecs.Core where  import           Control.Monad.Reader-import           Data.Functor.Identity import qualified Data.Vector.Unboxed   as U -import qualified Apecs.THTuples        as T- -- | An Entity is just an integer, used to index into a component store. --   In general, use @newEntity@, @cmap@, and component tags instead of manipulating these directly. -- --   For performance reasons, negative values like (-1) are reserved for stores to represent special values, so avoid using these. newtype Entity = Entity {unEntity :: Int} deriving (Num, Eq, Ord, Show, Enum) --- | A SystemT is a newtype around `ReaderT w IO a`, where `w` is the game world variable.---   Systems mainly serve to------   * Lift side effects into the IO Monad.+-- | A SystemT is a newtype around `ReaderT w m a`, where `w` is the game world variable.+--   Systems serve to -- --   * Allow type-based lookup of a component's store through @getStore@.+--+--   * Lift side effects into their host Monad. newtype SystemT w m a = SystemT {unSystem :: ReaderT w m a} deriving (Functor, Monad, Applicative, MonadTrans, MonadIO) type System w a = SystemT w IO a @@ -80,184 +77,3 @@ type Members w m c = (Has w m c, ExplMembers m (Storage c)) type Destroy w m c = (Has w m c, ExplDestroy m (Storage c)) --- | Identity component/store. @Identity c@ is equivalent to @c@, so using it is mostly useless.-instance Component c => Component (Identity c) where-  type Storage (Identity c) = Identity (Storage c)--instance Has w m c => Has w m (Identity c) where-  {-# INLINE getStore #-}-  getStore = Identity <$> getStore--type instance Elem (Identity s) = Identity (Elem s)--instance ExplGet m s => ExplGet m (Identity s) where-  {-# INLINE explGet #-}-  explGet (Identity s) e = Identity <$> explGet s e-  {-# INLINE explExists  #-}-  explExists  (Identity s) = explExists s--instance ExplSet m s => ExplSet m (Identity s) where-  {-# INLINE explSet #-}-  explSet (Identity s) e (Identity x) = explSet s e x-instance ExplMembers m s => ExplMembers m (Identity s) where-  {-# INLINE explMembers #-}-  explMembers (Identity s) = explMembers s-instance ExplDestroy m s => ExplDestroy m (Identity s) where-  {-# INLINE explDestroy #-}-  explDestroy (Identity s) = explDestroy s--T.makeInstances [2..8]---- | Psuedocomponent indicating the absence of @a@.---   Mainly used as e.g. @cmap $ \(a, Not b) -> c@ to iterate over entities with an @a@ but no @b@.---   Can also be used to delete components, like @cmap $ \a -> (Not :: Not a)@ to delete every @a@ component.-data Not a = Not---- | Pseudostore used to produce values of type @Not a@, inverts @explExists@, and destroys instead of @explSet@.-newtype NotStore s = NotStore s--instance Component c => Component (Not c) where-  type Storage (Not c) = NotStore (Storage c)--instance (Has w m c) => Has w m (Not c) where-  {-# INLINE getStore #-}-  getStore = NotStore <$> getStore--type instance Elem (NotStore s) = Not (Elem s)--instance ExplGet m s => ExplGet m (NotStore s) where-  {-# INLINE explGet #-}-  explGet _ _ = return Not-  {-# INLINE explExists #-}-  explExists (NotStore sa) ety = not <$> explExists sa ety--instance ExplDestroy m s => ExplSet m (NotStore s) where-  {-# INLINE explSet #-}-  explSet (NotStore sa) ety _ = explDestroy sa ety---- | Pseudostore used to produce values of type @Maybe a@.---   Will always return @True@ for @explExists@.---   Writing can both set and delete a component using @Just@ and @Nothing@ respectively.-newtype MaybeStore s = MaybeStore s-instance Component c => Component (Maybe c) where-  type Storage (Maybe c) = MaybeStore (Storage c)--instance (Has w m c) => Has w m (Maybe c) where-  {-# INLINE getStore #-}-  getStore = MaybeStore <$> getStore--type instance Elem (MaybeStore s) = Maybe (Elem s)--instance ExplGet m s => ExplGet m (MaybeStore s) where-  {-# INLINE explGet #-}-  explGet (MaybeStore sa) ety = do-    e <- explExists sa ety-    if e then Just <$> explGet sa ety-         else return Nothing-  explExists _ _ = return True--instance (ExplDestroy m s, ExplSet m s) => ExplSet m (MaybeStore s) where-  {-# INLINE explSet #-}-  explSet (MaybeStore sa) ety Nothing  = explDestroy sa ety-  explSet (MaybeStore sa) ety (Just x) = explSet sa ety x---- | Used for 'Either', a logical disjunction between two components.---   As expected, Either is used to model error values.--- Getting an @Either a b@ will first attempt to get a @b@ and return it as @Right b@, or if it does not exist, get an @a@ as @Left a@.--- Can also be used to set one of two things.-data EitherStore sa sb = EitherStore sa sb-instance (Component ca, Component cb) => Component (Either ca cb) where-  type Storage (Either ca cb) = EitherStore (Storage ca) (Storage cb)--instance (Has w m ca, Has w m cb) => Has w m (Either ca cb) where-  {-# INLINE getStore #-}-  getStore = EitherStore <$> getStore <*> getStore--type instance Elem (EitherStore sa sb) = Either (Elem sa) (Elem sb)--instance (ExplGet m sa, ExplGet m sb) => ExplGet m (EitherStore sa sb) where-  {-# INLINE explGet #-}-  explGet (EitherStore sa sb) ety = do-    e <- explExists sb ety-    if e then Right <$> explGet sb ety-         else Left <$> explGet sa ety-  {-# INLINE explExists #-}-  explExists (EitherStore sa sb) ety = do-    e <- explExists sb ety-    if e then return True-         else explExists sa ety--instance (ExplSet m sa, ExplSet m sb) => ExplSet m (EitherStore sa sb) where-  {-# INLINE explSet #-}-  explSet (EitherStore _ sb) ety (Right b) = explSet sb ety b-  explSet (EitherStore sa _) ety (Left a)  = explSet sa ety a--instance (ExplDestroy m sa, ExplDestroy m sb)-       => ExplDestroy m (EitherStore sa sb) where-  {-# INLINE explDestroy #-}-  explDestroy (EitherStore sa sb) ety =-    explDestroy sa ety >> explDestroy sb ety--instance Monad m => Has w m () where-  {-# INLINE getStore #-}-  getStore = return ()-instance Component () where-  type Storage () = ()-type instance Elem () = ()-instance Monad m => ExplGet m () where-  {-# INLINE explExists #-}-  explExists _ _ = return True-  {-# INLINE explGet #-}-  explGet _ _ = return ()-instance Monad m => ExplSet m () where-  {-# INLINE explSet #-}-  explSet _ _ _ = return ()-instance Monad m => ExplDestroy m () where-  {-# INLINE explDestroy #-}-  explDestroy _ _ = return ()---- | Pseudocomponent that functions normally for @explExists@ and @explMembers@, but always return @Filter@ for @explGet@.---   Can be used in cmap as @cmap $ \(Filter :: Filter a) -> b@.---   Since the above can be written more consicely as @cmap $ \(_ :: a) -> b@, it is rarely directly.---   More interestingly, we can define reusable filters like @movables = Filter :: Filter (Position, Velocity)@.-data Filter c = Filter deriving (Eq, Show)---- Pseudostore for 'Filter'.-newtype FilterStore s = FilterStore s--instance Component c => Component (Filter c) where-  type Storage (Filter c) = FilterStore (Storage c)--instance Has w m c => Has w m (Filter c) where-  {-# INLINE getStore #-}-  getStore = FilterStore <$> getStore--type instance Elem (FilterStore s) = Filter (Elem s)--instance ExplGet m s => ExplGet m (FilterStore s) where-  {-# INLINE explGet #-}-  explGet _ _ = return Filter-  {-# INLINE explExists #-}-  explExists (FilterStore s) ety = explExists s ety--instance ExplMembers m s => ExplMembers m (FilterStore s) where-  {-# INLINE explMembers #-}-  explMembers (FilterStore s) = explMembers s---- | Pseudostore used to produce components of type 'Entity'.--- Always returns @True@ for @explExists@, and echoes back the entity argument for @explGet@.--- Used in e.g. @cmap $ \(a, ety :: Entity) -> b@ to access the current entity.-data EntityStore = EntityStore-instance Component Entity where-  type Storage Entity = EntityStore--instance Monad m => Has w m Entity where-  {-# INLINE getStore #-}-  getStore = return EntityStore--type instance Elem EntityStore = Entity-instance Monad m => ExplGet m EntityStore where-  {-# INLINE explGet #-}-  explGet _ ety = return $ Entity ety-  {-# INLINE explExists #-}-  explExists _ _ = return True

@@ -0,0 +1,131 @@+{-|+Stability : experimental++Reactive stores module, still experimental.+Adds the @Reactive r s@ store, which when wrapped around store @s@, will call the @react@ on its @r@.++@Show c => Reactive (Printer c) (Map c)@ will print a message every time a @c@ value is set.++@Enum c => Reactive (EnumMap c) (Map c)@ allows you to look up entities by component value.+Use e.g. @rget >>= mapLookup True@ to retrieve a list of entities that have a @True@ component.++-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}++module Apecs.Reactive where++import           Control.Monad.Reader+import qualified Data.IntMap.Strict   as M+import qualified Data.IntSet          as S+import           Data.IORef++import           Apecs.Core+import           Apecs.Components++-- | Analogous to @Elem@, but for @Reacts@ instances.+--   For a @Reactive r s@ to be valid, @ReactElem r = Elem s@+type family ReactElem r++-- | Class required by @Reactive@.+--   Given some @r@ and update information about some component, will run a side-effect in monad @m@.+--   Note that there are also instances for @(,)@.+class Monad m => Reacts m r where+  rempty :: m r+  react  :: Entity -> Maybe (ReactElem r) -> Maybe (ReactElem r) -> r -> m ()++type instance ReactElem (a,b) = ReactElem a+instance (ReactElem a ~ ReactElem b, Reacts m a, Reacts m b) => Reacts m (a, b) where+  {-# INLINE rempty #-}+  rempty = liftM2 (,) rempty rempty+  {-# INLINE react #-}+  react ety old new (a,b) = react ety old new a >> react ety old new b++-- | Wrapper for reactivity around some store s.+data Reactive r s = Reactive r s++type instance Elem (Reactive r s) = Elem s++-- | Reads @r@ from the game world.+rget :: forall w m r s.+  ( Component (ReactElem r)+  , Has w m (ReactElem r)+  , Storage (ReactElem r) ~ Reactive r s+  ) => SystemT w m r+rget = do+  Reactive r (_ :: s) <- getStore+  return r++instance (Reacts m r, ExplInit m s) => ExplInit m (Reactive r s) where+  explInit = liftM2 Reactive rempty explInit++instance (Reacts m r, ExplSet m s, ExplGet m s, Elem s ~ ReactElem r)+  => ExplSet m (Reactive r s) where+  {-# INLINE explSet #-}+  explSet (Reactive r s) ety c = do+    old <- explGet (MaybeStore s) ety+    react (Entity ety) old (Just c) r+    explSet s ety c++instance (Reacts m r, ExplDestroy m s, ExplGet m s, Elem s ~ ReactElem r)+  => ExplDestroy m (Reactive r s) where+  {-# INLINE explDestroy #-}+  explDestroy (Reactive r s) ety = do+    old <- explGet (MaybeStore s) ety+    react (Entity ety) old Nothing r+    explDestroy s ety++instance ExplGet m s => ExplGet m (Reactive r s) where+  {-# INLINE explExists #-}+  explExists (Reactive _ s) = explExists s+  {-# INLINE explGet    #-}+  explGet    (Reactive _ s) = explGet    s++instance ExplMembers m s => ExplMembers m (Reactive r s) where+  {-# INLINE explMembers #-}+  explMembers (Reactive _ s) = explMembers s++-- | Prints a message to stdout every time a component is updated.+data Printer c = Printer+type instance ReactElem (Printer c) = c++instance (MonadIO m, Show c) => Reacts m (Printer c) where+  {-# INLINE rempty #-}+  rempty = return Printer+  {-# INLINE react #-}+  react (Entity ety) (Just c) Nothing _ = liftIO$+    putStrLn $ "Entity " ++ show ety ++ ": destroyed component " ++ show c+  react (Entity ety) Nothing (Just c) _ = liftIO$+    putStrLn $ "Entity " ++ show ety ++ ": created component " ++ show c+  react (Entity ety) (Just old) (Just new) _ = liftIO$+    putStrLn $ "Entity " ++ show ety ++ ": update component " ++ show old ++ " to " ++ show new+  react _ _ _ _ = return ()++-- | Allows you to look up entities by component value.+--   Use e.g. @rget >>= mapLookup True@ to retrieve a list of entities that have a @True@ component.+newtype EnumMap c = EnumMap (IORef (M.IntMap S.IntSet))++type instance ReactElem (EnumMap c) = c+instance (MonadIO m, Enum c) => Reacts m (EnumMap c) where+  {-# INLINE rempty #-}+  rempty = liftIO$ EnumMap <$> newIORef mempty+  {-# INLINE react #-}+  react _ Nothing Nothing _ = return ()+  react (Entity ety) (Just c) Nothing (EnumMap ref) = liftIO$+    modifyIORef' ref (M.adjust (S.delete ety) (fromEnum c))+  react (Entity ety) Nothing (Just c) (EnumMap ref) = liftIO$+    modifyIORef' ref (M.insertWith mappend (fromEnum c) (S.singleton ety))+  react (Entity ety) (Just old) (Just new) (EnumMap ref) = liftIO$ do+    modifyIORef' ref (M.adjust (S.delete ety) (fromEnum old))+    modifyIORef' ref (M.insertWith mappend (fromEnum new) (S.singleton ety))+++{-# INLINE mapLookup #-}+mapLookup :: Enum c => EnumMap c -> c -> System w [Entity]+mapLookup (EnumMap ref) c = do+  emap <- liftIO $ readIORef ref+  return $ maybe [] (fmap Entity . S.toList) (M.lookup (fromEnum c) emap)

@@ -18,7 +18,6 @@  import           Control.Monad.Reader import qualified Data.IntMap.Strict          as M-import qualified Data.IntSet                 as S import           Data.IORef import           Data.Maybe                  (fromJust) import           Data.Proxy@@ -33,81 +32,84 @@ newtype Map c = Map (IORef (M.IntMap c))  type instance Elem (Map c) = c-instance ExplInit IO (Map c) where-  explInit = Map <$> newIORef mempty+instance MonadIO m => ExplInit m (Map c) where+  explInit = liftIO$ Map <$> newIORef mempty -instance ExplGet IO (Map c) where-  explExists (Map ref) ety = M.member ety <$> readIORef ref-  explGet    (Map ref) ety =+instance MonadIO m => ExplGet m (Map c) where+  explExists (Map ref) ety = liftIO$ M.member ety <$> readIORef ref+  explGet    (Map ref) ety = liftIO$     fromJust . M.lookup ety <$> readIORef ref   {-# INLINE explExists #-}   {-# INLINE explGet #-} -instance ExplSet IO (Map c) where+instance MonadIO m => ExplSet m (Map c) where   {-# INLINE explSet #-}-  explSet (Map ref) ety x =+  explSet (Map ref) ety x = liftIO$     modifyIORef' ref (M.insert ety x) -instance ExplDestroy IO (Map c) where+instance MonadIO m => ExplDestroy m (Map c) where   {-# INLINE explDestroy #-}-  explDestroy (Map ref) ety =+  explDestroy (Map ref) ety = liftIO$     readIORef ref >>= writeIORef ref . M.delete ety -instance ExplMembers IO (Map c) where+instance MonadIO m => ExplMembers m (Map c) where   {-# INLINE explMembers #-}-  explMembers (Map ref) = U.fromList . M.keys <$> readIORef ref+  explMembers (Map ref) = liftIO$ U.fromList . M.keys <$> readIORef ref  -- | A Unique contains zero or one component. --   Writing to it overwrites both the previous component and its owner. --   Its main purpose is to be a @Map@ optimized for when only ever one component inhabits it. newtype Unique c = Unique (IORef (Maybe (Int, c))) type instance Elem (Unique c) = c-instance ExplInit IO (Unique c) where-  explInit = Unique <$> newIORef Nothing+instance MonadIO m => ExplInit m (Unique c) where+  explInit = liftIO$ Unique <$> newIORef Nothing -instance ExplGet IO (Unique c) where+instance MonadIO m => ExplGet m (Unique c) where   {-# INLINE explGet #-}-  explGet (Unique ref) _ = flip fmap (readIORef ref) $ \case+  explGet (Unique ref) _ = liftIO$ flip fmap (readIORef ref) $ \case     Nothing -> error "Reading empty Unique"     Just (_, c)  -> c   {-# INLINE explExists #-}-  explExists (Unique ref) ety = maybe False ((==ety) . fst) <$> readIORef ref+  explExists (Unique ref) ety = liftIO$ maybe False ((==ety) . fst) <$> readIORef ref -instance ExplSet IO (Unique c) where+instance MonadIO m => ExplSet m (Unique c) where   {-# INLINE explSet #-}-  explSet (Unique ref) ety c = writeIORef ref (Just (ety, c))+  explSet (Unique ref) ety c = liftIO$ writeIORef ref (Just (ety, c)) -instance ExplDestroy IO (Unique c) where+instance MonadIO m => ExplDestroy m (Unique c) where   {-# INLINE explDestroy #-}-  explDestroy (Unique ref) ety = readIORef ref >>=+  explDestroy (Unique ref) ety = liftIO$ readIORef ref >>=     mapM_ (flip when (writeIORef ref Nothing) . (==ety) . fst) -instance ExplMembers IO (Unique c) where+instance MonadIO m => ExplMembers m (Unique c) where   {-# INLINE explMembers #-}-  explMembers (Unique ref) = flip fmap (readIORef ref) $ \case+  explMembers (Unique ref) = liftIO$ flip fmap (readIORef ref) $ \case     Nothing -> mempty     Just (ety, _) -> U.singleton ety --- | A Global contains exactly one component.+-- | A @Global@ contains exactly one component. --   The initial value is 'mempty' from the component's 'Monoid' instance. -----   When operating on a global, any entity arguments are ignored.---   For example, we can get a global component with @get 0@ or @get 1@ or even @get undefined@.+--   When operating on a Global, any entity arguments are ignored.+--   A Global component can be read with @get 0@ or @get 1@ or even @get undefined@.+--   This means that you can read and write Globals while @cmap@ping over other components.+--+--   The integer @global@ is defined as -1, and can be used to make operations on a global explicit, i.e. 'Time t <- get global'. newtype Global c = Global (IORef c) type instance Elem (Global c) = c-instance Monoid c => ExplInit IO (Global c) where+instance (Monoid c, MonadIO m) => ExplInit m (Global c) where   {-# INLINE explInit #-}-  explInit = Global <$> newIORef mempty+  explInit = liftIO$ Global <$> newIORef mempty -instance ExplGet IO (Global c) where+instance MonadIO m => ExplGet m (Global c) where   {-# INLINE explGet #-}-  explGet (Global ref) _ = readIORef ref+  explGet (Global ref) _ = liftIO$ readIORef ref   {-# INLINE explExists #-}   explExists _ _ = return True -instance ExplSet IO (Global c) where+instance MonadIO m => ExplSet m (Global c) where   {-# INLINE explSet #-}-  explSet (Global ref) _ c = writeIORef ref c+  explSet (Global ref) _ c = liftIO$ writeIORef ref c  -- | An empty type class indicating that the store behaves like a regular map, and can therefore safely be cached. class Cachable s@@ -131,107 +133,54 @@  type instance Elem (Cache n s) = Elem s -instance (ExplInit IO s, KnownNat n, Cachable s) => ExplInit IO (Cache n s) where+instance (MonadIO m, ExplInit m s, KnownNat n, Cachable s) => ExplInit m (Cache n s) where   {-# INLINE explInit #-}   explInit = do     let n = fromIntegral$ natVal (Proxy @n)-    tags <- UM.replicate n (-2)-    cache <- VM.replicate n cacheMiss+    tags <- liftIO$ UM.replicate n (-2)+    cache <- liftIO$ VM.replicate n cacheMiss     child <- explInit     return (Cache n tags cache child) -instance ExplGet IO s => ExplGet IO (Cache n s) where+instance (MonadIO m, ExplGet m s) => ExplGet m (Cache n s) where   {-# INLINE explGet #-}   explGet (Cache n tags cache s) ety = do     let index = ety `rem` n-    tag <- UM.unsafeRead tags index+    tag <- liftIO$ UM.unsafeRead tags index     if tag == ety-       then VM.unsafeRead cache index+       then liftIO$ VM.unsafeRead cache index        else explGet s ety    {-# INLINE explExists #-}   explExists (Cache n tags _ s) ety = do-    tag <- UM.unsafeRead tags (ety `rem` n)+    tag <- liftIO$ UM.unsafeRead tags (ety `rem` n)     if tag == ety then return True else explExists s ety -instance ExplSet IO s => ExplSet IO (Cache n s) where+instance (MonadIO m, ExplSet m s) => ExplSet m (Cache n s) where   {-# INLINE explSet #-}   explSet (Cache n tags cache s) ety x = do     let index = ety `rem` n-    tag <- UM.unsafeRead tags index+    tag <- liftIO$ UM.unsafeRead tags index     when (tag /= (-2) && tag /= ety) $ do-      cached <- VM.unsafeRead cache index+      cached <- liftIO$ VM.unsafeRead cache index       explSet s tag cached-    UM.unsafeWrite tags  index ety-    VM.unsafeWrite cache index x+    liftIO$ UM.unsafeWrite tags  index ety+    liftIO$ VM.unsafeWrite cache index x -instance ExplDestroy IO s => ExplDestroy IO (Cache n s) where+instance (MonadIO m, ExplDestroy m s) => ExplDestroy m (Cache n s) where   {-# INLINE explDestroy #-}   explDestroy (Cache n tags cache s) ety = do     let index = ety `rem` n-    tag <- UM.unsafeRead tags (ety `rem` n)+    tag <- liftIO$ UM.unsafeRead tags (ety `rem` n)     if tag == ety        then do-         UM.unsafeWrite tags  index (-2)-         VM.unsafeWrite cache index cacheMiss+         liftIO$ UM.unsafeWrite tags  index (-2)+         liftIO$ VM.unsafeWrite cache index cacheMiss        else explDestroy s ety -instance ExplMembers IO s => ExplMembers IO (Cache n s) where+instance (MonadIO m, ExplMembers m s) => ExplMembers m (Cache n s) where   {-# INLINE explMembers #-}   explMembers (Cache _ tags _ s) = do-    cached <- U.filter (/= (-2)) <$> U.freeze tags+    cached <- liftIO$ U.filter (/= (-2)) <$> U.freeze tags     stored <- explMembers s     return $! cached U.++ stored--{---data Register s = Register (VM.IOVector S.IntSet) s-type instance Elem (Register s) = Elem s--instance (Cachable s, ExplInit IO s, Bounded (Elem s), Enum (Elem s)) => ExplInit IO (Register s) where-  explInit = do-    vec <- VM.replicate-             (fromEnum (maxBound :: Elem s) - fromEnum (minBound :: Elem s) + 1)-             mempty-    s <- explInit-    return $ Register vec s--instance ExplGet m s => ExplGet m (Register s) where-  {-# INLINE explGet #-}-  explExists (Register _ s) e = explExists s e-  explGet (Register _ s) e = explGet s e--instance (ExplGet IO s, ExplSet IO s, Bounded (Elem s), Enum (Elem s)) => ExplSet IO (Register s) where-  explSet (Register vec s) ety x = do-    let offset = negate $ fromEnum (minBound :: Elem s)-    ex <- explExists s ety-    when ex $ do-      xOld <- explGet s ety-      VM.modify vec (S.delete ety) (fromEnum xOld - offset)-    VM.modify vec (S.insert ety) (fromEnum x - offset)-    explSet s ety x--instance (ExplGet IO s, ExplDestroy IO s, Bounded (Elem s), Enum (Elem s)) => ExplDestroy IO (Register s) where-  explDestroy (Register vec s) ety = do-    let offset = negate $ fromEnum (minBound :: Elem s)-    ex <- explExists s ety-    when ex $ do-      xOld <- explGet s ety-      VM.modify vec (S.delete ety) (fromEnum xOld - offset)-    explDestroy s ety--instance ExplMembers m s => ExplMembers m (Register s) where-  {-# INLINE explMembers #-}-  explMembers (Register _ s) = explMembers s--regLookup :: forall w s c.-  ( Component c, Bounded c, Enum c-  , Has w IO c-  , Storage c ~ Register s-  , c ~ Elem s-  )-  => c -> System w [Entity]-regLookup c = do-  let offset = negate $ fromEnum (minBound :: Elem s)-  Register vec _ :: Register s <- getStore-  fmap Entity . S.toList <$> lift (VM.read vec (fromEnum c - offset))---}

@@ -0,0 +1,145 @@+{-|+Stability: experimtal++Containment module for stores that are experimental/too weird for @Apecs.Stores@.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++module Apecs.Stores.Extra+  ( Pushdown(..), Stack(..)+  , ReadOnly(..), setReadOnly, destroyReadOnly+  ) where++import           Control.Monad.Reader+import           Data.Proxy++import           Apecs.Core++-- | Overrides a store to have history/pushdown semantics.+--   Setting this store adds a new value on top of the stack.+--   Destroying pops the stack.+--   You can view the entire stack using the @Stack c@ component.+newtype Pushdown s c = Pushdown (s (Stack c))+newtype Stack c = Stack {getStack :: [c]}++type instance Elem (Pushdown s c) = c++instance (Functor m, ExplInit m (s (Stack c))) => ExplInit m (Pushdown s c) where+  explInit = Pushdown <$> explInit++instance+  ( Monad m+  , ExplGet m (s (Stack c))+  , Elem (s (Stack c)) ~ Stack c+  ) => ExplGet m (Pushdown s c) where+    explExists (Pushdown s) = explExists s+    explGet    (Pushdown s) ety = head . getStack <$> explGet s ety++instance+  ( Monad m+  , ExplGet m (s (Stack c))+  , ExplSet m (s (Stack c))+  , Elem (s (Stack c)) ~ Stack c+  ) => ExplSet m (Pushdown s c) where+    explSet (Pushdown s) ety c = do+      Stack cs <- explGet s ety+      explSet s ety (Stack (c:cs))++instance+  ( Monad m+  , ExplGet m (s (Stack c))+  , ExplSet m (s (Stack c))+  , ExplDestroy m (s (Stack c))+  , Elem (s (Stack c)) ~ Stack c+  ) => ExplDestroy m (Pushdown s c) where+    explDestroy (Pushdown s) ety = do+      Stack cs <- explGet s ety+      case cs of+        _:cs' -> explSet s ety (Stack cs')+        []    -> explDestroy s ety++instance+  ( Monad m+  , ExplMembers m (s (Stack c))+  , Elem (s (Stack c)) ~ Stack c+  ) => ExplMembers m (Pushdown s c) where+    explMembers (Pushdown s) = explMembers s++instance (Storage c ~ Pushdown s c, Component c) => Component (Stack c) where+  type Storage (Stack c) = StackStore (Storage c)++newtype StackStore s = StackStore s+type instance Elem (StackStore s) = Stack (Elem s)++instance (Storage c ~ Pushdown s c, Has w m c) => Has w m (Stack c) where+  getStore = StackStore <$> getStore++instance+  ( Elem (s (Stack c)) ~ Stack c+  , ExplGet m (s (Stack c))+  ) => ExplGet m (StackStore (Pushdown s c)) where+  explExists (StackStore s) = explExists s+  explGet (StackStore (Pushdown s)) = explGet s++instance+  ( Elem (s (Stack c)) ~ Stack c+  , ExplSet     m (s (Stack c))+  , ExplDestroy m (s (Stack c))+  ) => ExplSet m (StackStore (Pushdown s c)) where+  explSet (StackStore (Pushdown s)) ety (Stack []) = explDestroy s ety+  explSet (StackStore (Pushdown s)) ety st         = explSet s ety st++instance+  ( Elem (s (Stack c)) ~ Stack c+  , ExplDestroy m (s (Stack c))+  ) => ExplDestroy m (StackStore (Pushdown s c)) where+  explDestroy (StackStore (Pushdown s)) = explDestroy s++instance+  ( Elem (s (Stack c)) ~ Stack c+  , ExplMembers m (s (Stack c))+  ) => ExplMembers m (StackStore (Pushdown s c)) where+  explMembers (StackStore (Pushdown s)) = explMembers s++-- | Wrapper that makes a store read-only. Use @setReadOnly@ and @destroyReadOnly@ to override.+newtype ReadOnly s = ReadOnly s+type instance Elem (ReadOnly s) = Elem s++instance (Functor m, ExplInit m s) => ExplInit m (ReadOnly s) where+  explInit = ReadOnly <$> explInit++instance ExplGet m s => ExplGet m (ReadOnly s) where+  explExists (ReadOnly s) = explExists s+  explGet    (ReadOnly s) = explGet s+  {-# INLINE explExists #-}+  {-# INLINE explGet #-}++instance ExplMembers m s => ExplMembers m (ReadOnly s) where+  {-# INLINE explMembers #-}+  explMembers (ReadOnly s) = explMembers s++setReadOnly :: forall w m s c.+  ( Has w m c+  , Storage c ~ ReadOnly s+  , Elem s ~ c+  , ExplSet m s+  ) => Entity -> c -> SystemT w m ()+setReadOnly (Entity ety) c = do+  ReadOnly s <- getStore+  lift $ explSet s ety c++destroyReadOnly :: forall w m s c.+  ( Has w m c+  , Storage c ~ ReadOnly s+  , Elem s ~ c+  , ExplDestroy m s+  ) => Entity -> Proxy c -> SystemT w m ()+destroyReadOnly (Entity ety) _ = do+  ReadOnly s :: Storage c <- getStore+  lift $ explDestroy s ety

@@ -11,6 +11,7 @@ import qualified Data.Vector.Unboxed  as U  import           Apecs.Core+import           Apecs.Components ()  -- | Run a system with a game world {-# INLINE runSystem #-}@@ -38,7 +39,6 @@   lift$ explSet s ety x  -- | Returns whether the given entity has component @c@---   Note that @c@ is a phantom argument, used only to convey the type of the entity to be queried. {-# INLINE exists #-} exists :: forall w m c. Get w m c => Entity -> Proxy c -> SystemT w m Bool exists (Entity ety) _ = do@@ -146,7 +146,6 @@   forM (U.toList sl) $ lift . explGet s  -- | Destroys component @c@ for the given entity.--- Note that @c@ is a phantom argument, used only to convey the type of the entity to be destroyed. {-# INLINE destroy #-} destroy :: forall w m c. Destroy w m c => Entity -> Proxy c -> SystemT w m () destroy (Entity ety) ~_ = do

@@ -16,6 +16,7 @@  -- | Same as 'makeWorld', but has no 'EntityCounter' makeWorldNoEC :: String -> [Name] -> Q [Dec]+-- makeWorldNoEC _ [] = do makeWorldNoEC worldName cTypes = do   cTypesNames <- forM cTypes $ \t -> do     rec <- genName "rec"@@ -52,7 +53,7 @@   let ct = return$ ConT comp   head <$> [d| instance Component $ct where type Storage $ct = Map $ct |]   --- | Same as makeWorld, but also makes a component instance:+-- | Same as makeWorld, but also defines @Component@ instances with a @Map@ store. makeWorldAndComponents :: String -> [Name] -> Q [Dec] makeWorldAndComponents worldName cTypes = do   wdecls <- makeWorld worldName cTypes

@@ -26,6 +26,7 @@  import           Apecs.Core import           Apecs.Stores+import           Apecs.Stores.Extra import           Apecs.System  -- | Convenience entity, for use in places where the entity value does not matter, i.e. a global store.@@ -37,19 +38,19 @@ newtype EntityCounter = EntityCounter {getCounter :: Sum Int} deriving (Semigroup, Monoid, Eq, Show)  instance Component EntityCounter where-  type Storage EntityCounter = Global EntityCounter+  type Storage EntityCounter = ReadOnly (Global EntityCounter)  -- | Bumps the EntityCounter and yields its value {-# INLINE nextEntity #-}-nextEntity :: (Get w m EntityCounter, Set w m EntityCounter) => SystemT w m Entity+nextEntity :: (MonadIO m, Get w m EntityCounter) => SystemT w m Entity nextEntity = do EntityCounter n <- get global-                set global (EntityCounter $ n+1)+                setReadOnly global (EntityCounter $ n+1)                 return (Entity . getSum $ n)  -- | Writes the given components to a new entity, and yields that entity. -- The return value is often ignored. {-# INLINE newEntity #-}-newEntity :: (Set w m c, Get w m EntityCounter, Set w m EntityCounter)+newEntity :: (MonadIO m, Set w m c, Get w m EntityCounter)           => c -> SystemT w m Entity newEntity c = do ety <- nextEntity                  set ety c

@@ -19,6 +19,7 @@ import Control.Monad  import Apecs+import Apecs.Reactive import Apecs.Core import Apecs.Stores import Apecs.Util@@ -110,30 +111,29 @@ prop_setGetTuple = genericSetGet initTuples (undefined :: (T1,T2,T3)) prop_setSetTuple = genericSetSet initTuples (undefined :: (T1,T2,T3)) -{-- newtype TestBool = TestBool Bool deriving (Eq, Show, Bounded, Enum, Arbitrary)-instance Component TestBool where type Storage TestBool = Register (Map TestBool)+instance Component TestBool where type Storage TestBool = Reactive (EnumMap TestBool) (Map TestBool) -makeWorld "Registered" [''TestBool]+makeWorld "ReactiveWld" [''TestBool] -prop_setGetRegister = genericSetGet initRegistered (undefined :: TestBool)-prop_setSetRegister = genericSetSet initRegistered (undefined :: TestBool)+prop_setGetReactive = genericSetGet initReactiveWld (undefined :: TestBool)+prop_setSetReactive = genericSetSet initReactiveWld (undefined :: TestBool) prop_lookupValid :: [(Entity, TestBool)] -> [Entity] -> Property-prop_lookupValid writes deletes = assertSys initRegistered $ do+prop_lookupValid writes deletes = assertSys initReactiveWld $ do   forM_ writes  $ uncurry set   forM_ deletes $ flip destroy (Proxy @TestBool)    et <- fmap snd . filter ((== TestBool True ) . fst) <$> getAll   ef <- fmap snd . filter ((== TestBool False) . fst) <$> getAll -  rt <- regLookup (TestBool True)-  rf <- regLookup (TestBool False)+  let lookup enum = rget >>= flip mapLookup enum+  rt <- lookup (TestBool True)+  rf <- lookup (TestBool False)    return (  sort rt == sort et          && sort rf == sort ef          && all (`notElem` ef) et          )-         --}  return [] main = $quickCheckAll