apecs 0.2.1.1 → 0.2.2.0

raw patch · 11 files changed

+225/−249 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• apecs.cabal +1/−1
• bench/Main.hs +55/−50
• src/Apecs.hs +0/−4
• src/Apecs/Logs.hs +7/−9
• src/Apecs/Slice.hs +43/−42
• src/Apecs/Stores.hs +32/−39
• src/Apecs/System.hs +29/−32
• src/Apecs/Types.hs +33/−60
• src/Apecs/Util.hs +2/−2
• test/Main.hs +17/−2
• tutorials/RTS.md +6/−8

@@ -1,5 +1,5 @@ name:                apecs-version:             0.2.1.1+version:             0.2.2.0 homepage:            https://github.com/jonascarpay/apecs#readme license:             BSD3 license-file:        LICENSE

@@ -1,4 +1,5 @@ {-# LANGUAGE Strict, ScopedTypeVariables, DataKinds, TypeFamilies, MultiParamTypeClasses, TypeOperators #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}  import Criterion import qualified Criterion.Main as C@@ -7,70 +8,74 @@ import Apecs as A import Apecs.Stores import Apecs.Util+import qualified Apecs.Slice as S  import Linear -newtype Position = Position (V2 Float) deriving (Eq, Show)-instance Component Position where-  type Storage Position = Cache 10000 (Map Position)+data Group w1 w2 = Group+  { groupName :: String+  , naiveWorld :: IO w1+  , naiveInit :: System w1 ()+  , naiveRun  :: System w1 ()+  , improvedWorld :: IO w1+  , improvedInit :: System w1 ()+  , improvedRun  :: System w1 () } -newtype Velocity = Velocity (V2 Float) deriving (Eq, Show)-instance Component Velocity where-  type Storage Velocity = Cache 1000 (Map Velocity)+toBench (Group name w1 i1 r1 w2 i2 r2) =+  bgroup name+    [ bgroup "naive"    [bench "init" $ whnfIO (w1 >>= runSystem i1), bench "init and run" $ whnfIO (w2 >>= runSystem (i1 >> r1))]+    , bgroup "improved" [bench "init" $ whnfIO (w1 >>= runSystem i1), bench "init and run" $ whnfIO (w2 >>= runSystem (i2 >> r2))]+    ] -data World = World-  { positions     :: Storage Position-  , velocities    :: Storage Velocity-  , entityCounter :: Storage EntityCounter-  }+data W1 c = W1 {w1c1 :: (Storage c), w1ec :: Storage EntityCounter}+instance Component c => Has (W1 c) c where getStore = System $ asks w1c1+instance Has (W1 c) EntityCounter where getStore = System $ asks w1ec -instance World `Has` Position where-  getStore = System $ asks positions+w1with args = W1 <$> initStoreWith args <*> initCounter+w1 = w1with ()+w2with a1 a2 = W2 <$> initStoreWith a1 <*> initStoreWith a2 <*> initCounter+w2 = w2with () () -instance World `Has` Velocity where-  getStore = System $ asks velocities+data W2 a b = W2 { w2c1 :: Storage a , w2c2 :: Storage b, w2ec :: Storage EntityCounter}+instance (Component a, Component b) => Has (W2 a b) a where getStore = System $ asks w2c1+instance (Component a, Component b) => Has (W2 a b) b where getStore = System $ asks w2c2+instance Has (W2 a b) EntityCounter where getStore = System $ asks w2ec -instance World `Has` EntityCounter where-  getStore = System $ asks entityCounter+--Explicit vs implicit map+newtype Counter = Counter Int+instance Component Counter where type Storage Counter = Map Counter -emptyWorld :: IO World-emptyWorld = liftM3 World initStore initStore initCounter+mapExample = Group+  { groupName     = "Single component map"+  , naiveWorld    = w1 :: IO (W1 Counter)+  , naiveInit     = replicateM_ 10 (newEntity (Counter 0))+  , naiveRun      = owners >>= S.mapM_ (\(e :: Entity Counter) -> set e (Counter 1))+  , improvedWorld = w1 :: IO (W1 Counter)+  , improvedInit  = replicateM_ 10 (newEntity (Counter 0))+  , improvedRun   = cmap (const (Counter 1))+  } -cStep (Velocity v, Position p) = (Velocity v, Position (p+v))-rStep (Velocity v, Position p) = Position (p+v) -rStep' :: (Velocity, Position) -> Safe Position-rStep' (Velocity v, Position p) = Safe (Just (Position (p+v)))--wStep' :: Safe (Velocity, Position) -> Safe Position-wStep' (Safe (Just (Velocity v), Just (Position p))) = Safe (Just (Position (p+v)))--wStep :: Safe (Velocity, Position) -> Position-wStep (Safe (Just (Velocity v), Just (Position p))) = Position (p+v)+-- ecs_bench+newtype ECSPos = ECSPos (V2 Float) deriving (Eq, Show)+instance Component ECSPos where type Storage ECSPos = Cache 10000 (Map ECSPos) -{-# INLINE vstep #-}-vstep :: System World ()-vstep = cimapM_ $ \(e,(Velocity v,Position p)) -> set (cast e) (Position (p+v))+newtype ECSVel = ECSVel (V2 Float) deriving (Eq, Show)+instance Component ECSVel where type Storage ECSVel = Cache 1000 (Map ECSVel) -explicit = do sl :: Slice (Velocity, Position) <- owners-              sliceForMC_ sl $ \(e,Safe (Just (Velocity v), Just (Position p))) -> set (cast e) (Position $ p + v)+pvInit = do replicateM_ 1000 (newEntity (ECSPos 0, ECSVel 1))+            replicateM_ 9000 (newEntity (ECSPos 0)) -cStep1 (Velocity p) = (Velocity (p+1))+pvStep = rmap $ \(ECSVel v, ECSPos p) -> ECSPos (p+v) -initialize :: System World ()-initialize = do replicateM_ 1000 $ newEntity (Position 0, Velocity 1)-                replicateM_ 9000 $ newEntity (Position 0)+pvWorld :: IO (W2 ECSPos ECSVel)+pvWorld = w2  main :: IO ()-main = C.defaultMain [ bench "init" $ whnfIO (emptyWorld >>= runSystem initialize)-                     , bgroup "init and step"-                       [ bench "cmap"   $ whnfIO (emptyWorld >>= runSystem (initialize >> cmap  cStep))-                       , bench "cmap1"  $ whnfIO (emptyWorld >>= runSystem (initialize >> cmap  cStep1))-                       , bench "rmap"   $ whnfIO (emptyWorld >>= runSystem (initialize >> rmap  rStep))-                       , bench "rmap'"  $ whnfIO (emptyWorld >>= runSystem (initialize >> rmap' rStep'))-                       , bench "wmap"   $ whnfIO (emptyWorld >>= runSystem (initialize >> wmap  wStep))-                       , bench "wmap'"  $ whnfIO (emptyWorld >>= runSystem (initialize >> wmap' wStep'))-                       , bench "vstep"  $ whnfIO (emptyWorld >>= runSystem (initialize >> vstep))-                       , bench "forMC_" $ whnfIO (emptyWorld >>= runSystem (initialize >> explicit))-                       ]-                     ]+main = C.defaultMain+  [ bgroup "ecs_bench"+    [ bench "init" $ whnfIO (pvWorld >>= runSystem pvInit)+    , bench "step" $ whnfIO (pvWorld >>= runSystem (pvInit >> pvStep))+    ]+  , toBench mapExample+  ]

@@ -28,9 +28,6 @@     runSystem, runWith,     initStore, runGC, EntityCounter, initCounter, newEntity, -  -- All slice functions-  module SL,-   -- Reader   asks, ask, liftIO, lift, ) where@@ -39,7 +36,6 @@  import Apecs.Types import Apecs.System-import Apecs.Slice as SL import Apecs.Stores import Apecs.Util 

@@ -20,7 +20,7 @@  import Apecs.Types import Apecs.Stores-import Apecs.Slice+import qualified Apecs.Slice as Sl  -- | A PureLog is a piece of state @l c@ that is updated when components @c@ are written or destroyed. --   Note that @l :: * -> *@@@ -45,7 +45,7 @@  -- | Produces the log indicated by the return type. {-# INLINE getLog #-}-getLog :: forall w c l. (IsRuntime c, Has w c, HasLog (Storage c) l, Log l c) => System w (l c)+getLog :: forall w c l. (Store (Storage c), Has w c, HasLog (Storage c) l, Log l c) => System w (l c) getLog = do s :: Storage c <- getStore             return (explGetLog s) @@ -62,14 +62,14 @@   {-# INLINE logReset #-}   logReset (FromPure lref) = writeIORef lref pureEmpty --- | A @Logger l@ of some store updates its @Log l@ with the writes and deletes to @Store s@+-- | A @Logger l@ of some store updates its @Log l@ with the writes and deletes to store @s@ data Logger l s = Logger (l (Stores s)) s -instance (Log l (Stores s), Cachable s) => Initializable (Logger l s) where+instance (Log l (Stores s), Cachable s) => Store (Logger l s) where   type InitArgs (Logger l s) = InitArgs s+  type Stores (Logger l s) = Stores s   initStoreWith args = Logger <$> logEmpty <*> initStoreWith args -instance (Log l (Stores s), Cachable s) => HasMembers (Logger l s) where   {-# INLINE explDestroy #-}   explDestroy (Logger l s) ety = do     mc <- explGet s ety@@ -88,9 +88,7 @@   {-# INLINE explImapM #-}   explImapM (Logger _ s) = explImapM s -instance (Log l (Stores s), Cachable s) => Store (Logger l s) where   type SafeRW (Logger l s) = SafeRW s-  type Stores (Logger l s) = Stores s    {-# INLINE explGetUnsafe #-}   explGetUnsafe (Logger _ s) ety = explGetUnsafe s ety@@ -199,9 +197,9 @@ byIndex (EnumTable vec) c   | c < 0                  = return mempty   | c >= VM.length vec - 1 = return mempty-  | otherwise = liftIO$ sliceFromList . S.toList <$> VM.read vec c+  | otherwise = liftIO$ Sl.fromList . S.toList <$> VM.read vec c  -- | Query the @EnumTable@ by an example enum. --   Will not perform bound checks, so crashes if `fromEnum c < 0 && fromEnum c > fromEnum maxBound `. byEnum :: Enum c => EnumTable c -> c -> System w (Slice c)-byEnum (EnumTable vec) c = liftIO$ sliceFromList . S.toList <$> VM.read vec (fromEnum c)+byEnum (EnumTable vec) c = liftIO$ Sl.fromList . S.toList <$> VM.read vec (fromEnum c)

@@ -1,6 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances #-} +-- | This module is designed to be imported with qualified module Apecs.Slice where  import qualified Data.Vector.Unboxed as U@@ -10,85 +11,85 @@ import Apecs.Types  -- | Slice version of foldM_-{-# INLINE sliceFoldM_ #-}-sliceFoldM_ :: (a -> Entity c -> System w a) -> a -> Slice b -> System w ()-sliceFoldM_ f seed (Slice sl) = U.foldM'_ ((.Entity) . f) seed sl+{-# INLINE foldM_ #-}+foldM_ :: (a -> Entity c -> System w a) -> a -> Slice b -> System w ()+foldM_ f seed (Slice sl) = U.foldM'_ ((.Entity) . f) seed sl  -- | Gets the size of a slice (O(n))-{-# INLINE sliceSize #-}-sliceSize :: Slice a -> Int-sliceSize (Slice vec) = U.length vec+{-# INLINE size #-}+size :: Slice a -> Int+size (Slice vec) = U.length vec  -- | Tests whether a slice is empty (O(1))-{-# INLINE sliceNull #-}-sliceNull :: Slice a -> Bool-sliceNull (Slice vec) = U.null vec+{-# INLINE null #-}+null :: Slice a -> Bool+null (Slice vec) = U.null vec  -- | Construct a slice from a list of IDs-{-# INLINE sliceFromList #-}-sliceFromList :: [Int] -> Slice a-sliceFromList = Slice . U.fromList+{-# INLINE fromList #-}+fromList :: [Int] -> Slice a+fromList = Slice . U.fromList  -- | Monadically filter a slice-{-# INLINE sliceFilterM #-}-sliceFilterM :: (Entity c -> System w Bool) -> Slice c -> System w (Slice c)-sliceFilterM fm (Slice vec) = Slice <$> U.filterM (fm . Entity) vec+{-# INLINE filterM #-}+filterM :: (Entity c -> System w Bool) -> Slice c -> System w (Slice c)+filterM fm (Slice vec) = Slice <$> U.filterM (fm . Entity) vec  -- | Concatenates two slices. Equivalent to mappend-{-# INLINE sliceConcat #-}-sliceConcat :: Slice a -> Slice b -> Slice c-sliceConcat (Slice a) (Slice b) = Slice (a U.++ b)+{-# INLINE concat #-}+concat :: Slice a -> Slice b -> Slice c+concat (Slice a) (Slice b) = Slice (a U.++ b)  -- Slice traversal -- | Slice version of forM_-{-# INLINE sliceForM_ #-}-sliceForM_ :: Monad m => Slice c -> (Entity c -> m b) -> m ()-sliceForM_ (Slice vec) ma = U.forM_ vec (ma . Entity)+{-# INLINE forM_ #-}+forM_ :: Monad m => Slice c -> (Entity c -> m b) -> m ()+forM_ (Slice vec) ma = U.forM_ vec (ma . Entity)  -- | Slice version of forM-{-# INLINE sliceForM #-}-sliceForM :: Monad m => Slice c -> (Entity c -> m a) -> m [a]-sliceForM (Slice vec) ma = traverse (ma . Entity) (U.toList vec)+{-# INLINE forM #-}+forM :: Monad m => Slice c -> (Entity c -> m a) -> m [a]+forM (Slice vec) ma = traverse (ma . Entity) (U.toList vec)  -- | Iterates over a slice, and reads the components of the Slice's type argument.-{-# INLINE sliceForMC #-}-sliceForMC :: forall w c a. (Store (Storage c), Has w c) => Slice c -> ((Entity c,Safe c) -> System w a) -> System w [a]-sliceForMC (Slice vec) sys = do+{-# INLINE forMC #-}+forMC :: forall w c a. Has w c => Slice c -> ((Entity c,Safe c) -> System w a) -> System w [a]+forMC (Slice vec) sys = do   s :: Storage c <- getStore   for (U.toList vec) $ \e -> do     r <- liftIO$ explGet s e     sys (Entity e, Safe r)  -- | Iterates over a slice, and reads the components of the Slice's type argument.-{-# INLINE sliceForMC_ #-}-sliceForMC_ :: forall w c a. (Store (Storage c), Has w c) => Slice c -> ((Entity c,Safe c) -> System w a) -> System w ()-sliceForMC_ (Slice vec) sys = do+{-# INLINE forMC_ #-}+forMC_ :: forall w c a. Has w c => Slice c -> ((Entity c,Safe c) -> System w a) -> System w ()+forMC_ (Slice vec) sys = do   s :: Storage c <- getStore   U.forM_ vec $ \e -> do     r <- liftIO$ explGet s e     sys (Entity e, Safe r)  -- | Slice version of mapM_-{-# INLINE sliceMapM_ #-}-sliceMapM_ :: Monad m => (Entity c -> m a) -> Slice c -> m ()-sliceMapM_ ma (Slice vec) = U.mapM_ (ma . Entity) vec+{-# INLINE mapM_ #-}+mapM_ :: Monad m => (Entity c -> m a) -> Slice c -> m ()+mapM_ ma (Slice vec) = U.mapM_ (ma . Entity) vec  -- | Slice version of mapM-{-# INLINE sliceMapM #-}-sliceMapM :: Monad m => (Entity c -> m a) -> Slice c -> m [a]-sliceMapM ma (Slice vec) = traverse (ma . Entity) (U.toList vec)+{-# INLINE mapM #-}+mapM :: Monad m => (Entity c -> m a) -> Slice c -> m [a]+mapM ma (Slice vec) = traverse (ma . Entity) (U.toList vec)  -- | Iterates over a slice, and reads the components of the Slice's type argument.-{-# INLINE sliceMapMC #-}-sliceMapMC :: forall w c a. (Store (Storage c), Has w c) => ((Entity c,Safe c) -> System w a) -> Slice c -> System w [a]-sliceMapMC sys (Slice vec) = do+{-# INLINE mapMC #-}+mapMC :: forall w c a. Has w c => ((Entity c,Safe c) -> System w a) -> Slice c -> System w [a]+mapMC sys (Slice vec) = do   s :: Storage c <- getStore   for (U.toList vec) $ \e -> do     r <- liftIO$ explGet s e     sys (Entity e, Safe r)  -- | Iterates over a slice, and reads the components of the Slice's type argument.-{-# INLINE sliceMapMC_ #-}-sliceMapMC_ :: forall w c a. (Store (Storage c), Has w c) => ((Entity c, Safe c) -> System w a) -> Slice c -> System w ()-sliceMapMC_ sys vec = sliceForMC_ vec sys+{-# INLINE mapMC_ #-}+mapMC_ :: forall w c a. Has w c => ((Entity c, Safe c) -> System w a) -> Slice c -> System w ()+mapMC_ sys vec = forMC_ vec sys 

@@ -25,13 +25,18 @@  import Apecs.Types +{-# INLINE defaultSetMaybe #-}+defaultSetMaybe :: (Store s, SafeRW s ~ Maybe (Stores s)) => s -> Int -> Maybe (Stores s) -> IO ()+defaultSetMaybe s e Nothing  = explDestroy s e+defaultSetMaybe s e (Just c) = explSet s e c+ -- | A map from Data.Intmap.Strict. O(n log(n)) for most operations. --   Yields safe runtime representations of type @Maybe c@. newtype Map c = Map (IORef (M.IntMap c))-instance Initializable (Map c) where+instance Store (Map c) where   type InitArgs (Map c) = ()+  type Stores (Map c) = c   initStoreWith _ = Map <$> newIORef mempty-instance HasMembers (Map c) where   explDestroy (Map ref) ety = modifyIORef' ref (M.delete ety)   explMembers (Map ref)     = U.fromList . M.keys <$> readIORef ref   explExists  (Map ref) ety = M.member ety <$> readIORef ref@@ -40,14 +45,11 @@   {-# INLINE explMembers #-}   {-# INLINE explExists #-}   {-# INLINE explReset #-}-instance Store (Map c) where   type SafeRW (Map c) = Maybe c-  type Stores (Map c) = c   explGetUnsafe (Map ref) ety = fromJust . M.lookup ety <$> readIORef ref   explGet       (Map ref) ety = M.lookup ety <$> readIORef ref   explSet       (Map ref) ety x = modifyIORef' ref $ M.insert ety x-  explSetMaybe  s ety Nothing = explDestroy s ety-  explSetMaybe  s ety (Just x) = explSet s ety x+  explSetMaybe = defaultSetMaybe   explModify    (Map ref) ety f = modifyIORef' ref $ M.adjust f ety   explCmap      (Map ref) f = modifyIORef' ref $ M.map f   explCmapM_    (Map ref) ma = liftIO (readIORef ref) >>= mapM_ ma@@ -72,10 +74,10 @@ -- | A store that keeps membership, but holds no values. --   Produces @flag@ runtime values. newtype Set c = Set (IORef S.IntSet)-instance Initializable (Set c) where+instance Flag c => Store (Set c) where   type InitArgs (Set c) = ()+  type Stores (Set c) = c   initStoreWith _ = Set <$> newIORef mempty-instance HasMembers (Set c) where   explDestroy (Set ref) ety = modifyIORef' ref (S.delete ety)   explMembers (Set ref) = U.fromList . S.toList <$> readIORef ref   explReset (Set ref) = writeIORef ref mempty@@ -88,9 +90,7 @@   {-# INLINE explReset #-}   {-# INLINE explImapM_ #-}   {-# INLINE explImapM #-}-instance (Flag c) => Store (Set c) where   type SafeRW (Set c) = Bool-  type Stores (Set c) = c   explGetUnsafe _ _ = return flag   explGet (Set ref) ety = S.member ety <$> readIORef ref   explSet (Set ref) ety _ = modifyIORef' ref $ S.insert ety@@ -112,10 +112,10 @@ -- | A Unique contains exactly one component belonging to some entity. --   Writing to it overwrites both the previous component and its owner. data Unique c = Unique (IORef Int) (IORef c)-instance Initializable (Unique c) where+instance Store (Unique c) where   type InitArgs (Unique c) = ()+  type Stores (Unique c) = c   initStoreWith _ = Unique <$> newIORef (-1) <*> newIORef undefined-instance HasMembers (Unique c) where   explDestroy (Unique eref _) ety = do e <- readIORef eref; when (e==ety) (writeIORef eref (-1))   explMembers (Unique eref _) = U.singleton <$> readIORef eref   explReset   (Unique eref _) = writeIORef eref (-1)@@ -131,17 +131,14 @@   {-# INLINE explImapM_ #-}   {-# INLINE explImapM #-} -instance Store (Unique c) where   type SafeRW (Unique c) = Maybe c-  type Stores (Unique c) = c   explGetUnsafe (Unique _ cref) _ = readIORef cref   explGet       (Unique eref cref) ety = do     e <- readIORef eref     if e == ety then Just <$> readIORef cref else return Nothing    explSet       (Unique eref cref) ety x = writeIORef eref ety >> writeIORef cref x-  explSetMaybe  s ety Nothing = explDestroy s ety-  explSetMaybe  s ety (Just x) = explSet s ety x+  explSetMaybe = defaultSetMaybe   explCmap      (Unique _    cref) f = modifyIORef' cref f   explModify    (Unique eref cref) ety f = do     e <- readIORef eref@@ -175,55 +172,55 @@  -- | Constant value. Not very practical, but fun to write. newtype Const c = Const c-instance Initializable (Const c) where+instance Store (Const c) where   type InitArgs (Const c) = c+  type Stores (Const c) = c   initStoreWith c = return$ Const c-instance GlobalRW (Const c) c where-  explGlobalRead  (Const c) = return c-  explGlobalWrite  _ _ = return ()-  explGlobalModify _ _ = return ()-instance HasMembers (Const c) where   explDestroy _ _ = return ()   explExists  _ _  = return False   explMembers _ = return mempty   explReset _ = return ()-instance Store (Const c) where   type SafeRW (Const c) = c-  type Stores (Const c) = c   explGetUnsafe (Const c) _ = return c   explGet       (Const c) _ = return c   explSet       _ _ _ = return ()   explSetMaybe  _ _ _ = return ()   explModify    _ _ _ = return ()   explCmap       _ _ = return ()+instance GlobalStore (Const c) where  -- | Global value. --   Must be given an initial value upon construction. newtype Global c = Global (IORef c)-instance Initializable (Global c) where+instance GlobalStore (Global c) where+instance Store (Global c) where   type InitArgs (Global c) = c+  type Stores   (Global c) = c   initStoreWith c = Global <$> newIORef c -instance GlobalRW (Global c) c where-  explGlobalRead   (Global ref) = readIORef    ref-  explGlobalWrite  (Global ref) = writeIORef   ref-  explGlobalModify (Global ref) = modifyIORef' ref-  {-# INLINE explGlobalRead #-}-  {-# INLINE explGlobalWrite #-}-  {-# INLINE explGlobalModify #-}+  type SafeRW (Global c) = c+  explDestroy _ _ = return ()+  explExists _ _ = return False+  explGetUnsafe (Global ref) _ = readIORef ref+  explGet (Global ref) _ = readIORef ref+  explSet (Global ref) _ c = writeIORef ref c+  explSetMaybe = explSet+  explMembers = return mempty + -- | A cache around another store. --   The wrapped store must produce safe representations using Maybe. --   Note that iterating over a cache is linear in its size, so large, sparsely populated caches will actually decrease performance. data Cache (n :: Nat) s =   Cache Int (UM.IOVector Int) (VM.IOVector (Stores s)) s -class (Initializable s, HasMembers s, Store s, SafeRW s ~ Maybe (Stores s)) => Cachable s+class (Store s, SafeRW s ~ Maybe (Stores s)) => Cachable s instance Cachable (Map s) instance (KnownNat n, Cachable s) => Cachable (Cache n s) -instance (KnownNat n, Cachable s) => Initializable (Cache n s) where+instance (KnownNat n, Cachable s) => Store (Cache n s) where   type InitArgs (Cache n s) = (InitArgs s)+  type Stores (Cache n s) = Stores s   initStoreWith args = do     let n = fromIntegral$ natVal (Proxy @n)     tags <- UM.replicate n (-1)@@ -231,7 +228,6 @@     child <- initStoreWith args     return (Cache n tags cache child) -instance Cachable s => HasMembers (Cache n s) where   {-# INLINE explDestroy #-}   explDestroy (Cache n tags _ s) ety = do     tag <- UM.unsafeRead tags (ety `mod` n)@@ -266,9 +262,7 @@     as2 <- explImapM s ma     return (as1 ++ as2) -instance Cachable s => Store (Cache n s) where   type SafeRW (Cache n s) = SafeRW s-  type Stores (Cache n s) = Stores s    {-# INLINE explGetUnsafe #-}   explGetUnsafe (Cache n tags cache s) ety = do@@ -297,8 +291,7 @@     VM.unsafeWrite cache index x    {-# INLINE explSetMaybe #-}-  explSetMaybe c ety Nothing  = explDestroy c ety-  explSetMaybe c ety (Just x) = explSet c ety x+  explSetMaybe = defaultSetMaybe    {-# INLINE explCmap #-}   explCmap (Cache n tags cache s) f = do

@@ -24,7 +24,7 @@  -- | A slice containing all entities with component @c@ {-# INLINE owners #-}-owners :: forall w c. (Has w c, HasMembers (Storage c)) => System w (Slice c)+owners :: forall w c. Has w c => System w (Slice c) owners = do s :: Storage c <- getStore             liftIO$ Slice <$> explMembers s @@ -32,18 +32,19 @@ --   For composite components, this indicates whether the component --   has all its constituents {-# INLINE exists #-}-exists :: forall w c. (Has w c, HasMembers (Storage c)) => Entity c -> System w Bool+exists :: forall w c. Has w c => Entity c -> System w Bool exists (Entity n) = do s :: Storage c <- getStore                        liftIO$ explExists s n  -- | Destroys the component @c@ for the given entity {-# INLINE destroy #-}-destroy :: forall w c. (Has w c, HasMembers (Storage c)) => Entity c -> System w ()+destroy :: forall w c. Has w c => Entity c -> System w () destroy (Entity n) = do s :: Storage c <- getStore                         liftIO$ explDestroy s n  -- | Removes all components. Equivalent to manually iterating and deleting, but usually optimized.-resetStore :: forall w c p. (Has w c, HasMembers (Storage c)) => p c -> System w ()+{-# INLINE resetStore #-}+resetStore :: forall w c p. Has w c => p c -> System w () resetStore _ = do s :: Storage c <- getStore                   liftIO$ explReset s @@ -51,26 +52,27 @@ -- | Gets the component for a given entity. --   This is a safe access, because the entity might not have the requested components. {-# INLINE get #-}-get :: forall w c. (Store (Storage c), Has w c) => Entity c -> System w (Safe c)+get :: forall w c. Has w c => Entity c -> System w (Safe c) get (Entity ety) = do s :: Storage c <- getStore                       liftIO$ Safe <$> explGet s ety  -- | Writes a component to a given entity. Will overwrite existing components. {-# INLINE set #-}-set :: forall w c e. (IsRuntime c, Has w c) => Entity e -> c -> System w ()+set :: forall w c e. Has w c => Entity e -> c -> System w () set (Entity ety) x = do   s :: Storage c <- getStore   liftIO$ explSet s ety x  -- | Same as @set@, but uses Safe to possibly delete a component-set' :: forall w c. (IsRuntime c, Has w c) => Entity c -> Safe c -> System w ()+{-# INLINE set' #-}+set' :: forall w c. Has w c => Entity c -> Safe c -> System w () set' (Entity ety) (Safe c) = do   s :: Storage c <- getStore   liftIO$ explSetMaybe s ety c  -- | Applies a function if possible. Equivalent to reading, mapping, and writing, but stores can provide optimized implementations. {-# INLINE modify #-}-modify :: forall w c. (IsRuntime c, Has w c) => Entity c -> (c -> c) -> System w ()+modify :: forall w c. Has w c => Entity c -> (c -> c) -> System w () modify (Entity ety) f = do   s :: Storage c <- getStore   liftIO$ explModify s ety f@@ -78,56 +80,51 @@ {-# INLINE imapM_ #-} -- | Monadically iterate a system over all entities that have that component. --   Note that writing to the store while iterating over it is undefined behaviour.-imapM_ :: forall w c. (Has w c, HasMembers (Storage c))-       => (Entity c -> System w ()) -> System w ()+imapM_ :: forall w c. Has w c => (Entity c -> System w ()) -> System w () imapM_ sys = do s :: Storage c <- getStore                 explImapM_ s (sys . Entity)  {-# INLINE imapM #-} -- | Monadically iterate a system over all entities that have that component. --   Note that writing to the store while iterating over it is undefined behaviour.-imapM :: forall w c a. (Has w c, HasMembers (Storage c))+imapM :: forall w c a. Has w c       => (Entity c -> System w a) -> System w [a] imapM sys = do s :: Storage c <- getStore                explImapM s (sys . Entity)  -- | Maps a pure function over all components {-# INLINE cmap #-}-cmap :: forall world c. (IsRuntime c, Has world c) => (c -> c) -> System world ()+cmap :: forall world c. Has world c => (c -> c) -> System world () cmap f = do s :: Storage c <- getStore             liftIO$ explCmap s f  -- | mapM_ version of cmap {-# INLINE cmapM_ #-}-cmapM_ :: forall w c. (Has w c, IsRuntime c)-       => (c -> System w ()) -> System w ()+cmapM_ :: forall w c. Has w c => (c -> System w ()) -> System w () cmapM_ sys = do s :: Storage c <- getStore                 explCmapM_ s sys  -- | indexed cmapM_, also gives the current entity. {-# INLINE cimapM_ #-}-cimapM_ :: forall w c. (Has w c, IsRuntime c)-        => ((Entity c, c) -> System w ()) -> System w ()+cimapM_ :: forall w c. Has w c => ((Entity c, c) -> System w ()) -> System w () cimapM_ sys = do s :: Storage c <- getStore                  explCimapM_ s (\(e,c) -> sys (Entity e,c))  -- | mapM version of cmap. Can be used to get a list of entities {-# INLINE cmapM #-}-cmapM :: forall w c a. (Has w c, IsRuntime c)-      => (c -> System w a) -> System w [a]+cmapM :: forall w c a. Has w c => (c -> System w a) -> System w [a] cmapM sys = do s :: Storage c <- getStore                explCmapM s sys  -- | indexed cmapM, also gives the current entity. {-# INLINE cimapM #-}-cimapM :: forall w c a. (Has w c, IsRuntime c)-       => ((Entity c, c) -> System w a) -> System w [a]+cimapM :: forall w c a. Has w c => ((Entity c, c) -> System w a) -> System w [a] cimapM sys = do s :: Storage c <- getStore                 explCimapM s (\(e,c) -> sys (Entity e,c))  -- | Maps a function that might delete its components-cmap' :: forall world c. (Has world c, IsRuntime c)-      => (c -> Safe c) -> System world ()+{-# INLINE cmap' #-}+cmap' :: forall world c. Has world c => (c -> Safe c) -> System world () cmap' f = do s :: Storage c <- getStore              liftIO$ do sl <- explMembers s                         U.forM_ sl $ \e -> do@@ -136,7 +133,7 @@  -- | Maps a function over all entities with a @r@, and writes their @w@ {-# INLINE rmap #-}-rmap :: forall world r w. (Has world w, Has world r, IsRuntime w, IsRuntime r)+rmap :: forall world r w. (Has world w, Has world r)       => (r -> w) -> System world () rmap f = do sr :: Storage r <- getStore             sc :: Storage w <- getStore@@ -147,7 +144,7 @@  -- | Maps a function over all entities with a @r@, and writes or deletes their @w@ {-# INLINE rmap' #-}-rmap' :: forall world r w. (Has world w, Has world r, Store (Storage w), IsRuntime r)+rmap' :: forall world r w. (Has world w, Has world r, Store (Storage r), Store (Storage w))       => (r -> Safe w) -> System world () rmap' f = do sr :: Storage r <- getStore              sw :: Storage w <- getStore@@ -158,7 +155,7 @@  -- | For all entities with a @w@, this map reads their @r@ and writes their @w@ {-# INLINE wmap #-}-wmap :: forall world r w. (Has world w, Has world r, IsRuntime w, IsRuntime r)+wmap :: forall world r w. (Has world w, Has world r, Store (Storage r), Store (Storage w))      => (Safe r -> w) -> System world () wmap f = do sr :: Storage r <- getStore             sw :: Storage w <- getStore@@ -169,7 +166,7 @@  -- | For all entities with a @w@, this map reads their @r@ and writes or deletes their @w@ {-# INLINE wmap' #-}-wmap' :: forall world r w. (Has world w, Has world r, Store (Storage w), IsRuntime r)+wmap' :: forall world r w. (Has world w, Has world r, Store (Storage r), Store (Storage w))       => (Safe r -> Safe w) -> System world () wmap' f = do sr :: Storage r <- getStore              sw :: Storage w <- getStore@@ -180,19 +177,19 @@  -- | Reads a global value {-# INLINE readGlobal #-}-readGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => System w c+readGlobal :: forall w c. (Has w c, GlobalStore (Storage c)) => System w c readGlobal = do s :: Storage c <- getStore-                liftIO$ explGlobalRead s+                liftIO$ explGet s 0  -- | Writes a global value {-# INLINE writeGlobal #-}-writeGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => c -> System w ()+writeGlobal :: forall w c. (Has w c, GlobalStore (Storage c)) => c -> System w () writeGlobal c = do s :: Storage c <- getStore-                   liftIO$ explGlobalWrite s c+                   liftIO$ explSet s 0 c  -- | Modifies a global value {-# INLINE modifyGlobal #-}-modifyGlobal :: forall w c. (Has w c, GlobalRW (Storage c) c) => (c -> c) -> System w ()+modifyGlobal :: forall w c. (Has w c, GlobalStore (Storage c)) => (c -> c) -> System w () modifyGlobal f = do s :: Storage c <- getStore-                    liftIO$ explGlobalModify s f+                    liftIO$ explModify s 0 f 

@@ -22,24 +22,28 @@  -- | A component is defined by the type of its storage --   The storage in turn supplies runtime types for the component.---   For the component to be valid, its Storage must be in instance of Initializable.-class Initializable (Storage c) => Component c where+--   For the component to be valid, its Storage must be in instance of Store.+class (Stores (Storage c) ~ c, Store (Storage c)) => Component c where   type Storage c = s | s -> c  -- | A world `Has` a component if it can produce its Storage class Component c => Has w c where   getStore :: System w (Storage c) --- Storage types--- | Common for every storage. Represents a container that can be initialized.-class Initializable s where-  -- | The initialization argument required by this store-  type InitArgs s-  -- Initialize the store with its initialization arguments.-  initStoreWith :: InitArgs s -> IO s+-- | Represents a safe access to @c@. A safe access is either a read that might fail, or a write that might delete.+newtype Safe c = Safe {getSafe :: SafeRW (Storage c)} --- | A store that is indexed by entities.-class HasMembers s where+-- | Holds components indexed by entities+class Store s where+  -- | The type of components stored by this Store+  type Stores s+  -- | Return type for safe reads writes to the store+  type SafeRW s++  -- | Retrieves a component from the store+  explGet       :: s -> Int -> IO (SafeRW s)+  -- | Writes a component+  explSet       :: s -> Int -> Stores s -> IO ()   -- | Destroys the component for the given index.   explDestroy :: s -> Int -> IO ()   -- | Returns whether there is a component for the given index@@ -47,6 +51,16 @@   -- | Returns an unboxed vector of member indices   explMembers :: s -> IO (U.Vector Int) +  -- | Unsafe index to the store. Undefined if the component does not exist+  explGetUnsafe :: s -> Int -> IO (Stores s)+  -- | Either writes or deletes a component+  explSetMaybe  :: s -> Int -> SafeRW s -> IO ()++  -- | The initialization argument required by this store+  type InitArgs s+  -- Initialize the store with its initialization arguments.+  initStoreWith :: InitArgs s -> IO s+   -- | Removes all components.   --   Equivalent to calling @explDestroy@ on each member   {-# INLINE explReset #-}@@ -65,24 +79,6 @@   {-# INLINE explImapM #-}   explImapM s ma = liftIO (explMembers s) >>= mapM ma . U.toList --- | Represents a safe access to @c@. A safe access is either a read that might fail, or a write that might delete.-newtype Safe c = Safe {getSafe :: SafeRW (Storage c)}---- | Class of storages that associates components with entities.-class HasMembers s => Store s where-  -- | Return type for safe reads writes to the store-  type SafeRW s-  -- | The type of components stored by this Store-  type Stores s-  -- | Unsafe index to the store. Undefined if the component does not exist-  explGetUnsafe :: s -> Int -> IO (Stores s)-  -- | Retrieves a component from the store-  explGet       :: s -> Int -> IO (SafeRW s)-  -- | Writes a component-  explSet       :: s -> Int -> Stores s -> IO ()-  -- | Either writes or deletes a component-  explSetMaybe  :: s -> Int -> SafeRW s -> IO ()-   -- | Modifies an element in the store.   --   Equivalent to reading a value, and then writing the result of the function application.   {-# INLINE explModify #-}@@ -126,20 +122,8 @@       x :: Stores s <- liftIO$ explGetUnsafe s ety       sys (ety,x) --- | A constraint that indicates that the runtime representation of @c@ is @c@---   This will almost always be the case, but it _might_ not be so we need this constraint.-type IsRuntime c = (Store (Storage c), Stores (Storage c) ~ c)- -- | Class of storages for global values-class GlobalRW s c where-  {-# MINIMAL explGlobalRead, explGlobalWrite #-}-  explGlobalRead :: s -> IO c-  explGlobalWrite :: s -> c -> IO ()--  {-# INLINE explGlobalModify #-}-  explGlobalModify :: s -> (c -> c) -> IO ()-  explGlobalModify s f = do r <- explGlobalRead s-                            explGlobalWrite s (f r)+class (SafeRW s ~ Stores s, Store s) => GlobalStore s where  -- | Casts for entities and slices class Cast a b where@@ -155,15 +139,16 @@ -- (,) instance (Component a, Component b) => Component (a,b) where   type Storage (a, b) = (Storage a, Storage b)+ instance (Has w a, Has w b) => Has w (a,b) where   {-# INLINE getStore #-}   getStore = (,) <$> getStore <*> getStore -instance (Initializable a, Initializable b) => Initializable (a,b) where+instance (Store a, Store b) => Store (a,b) where   type InitArgs (a, b) = (InitArgs a, InitArgs b)+  type Stores (a, b) = (Stores a, Stores b)   initStoreWith (aa, ab) = (,) <$> initStoreWith aa <*> initStoreWith ab -instance (HasMembers a, HasMembers b) => HasMembers (a,b) where   explMembers (sa,sb) = explMembers sa >>= U.filterM (explExists sb)   explReset   (sa,sb) = explReset sa >> explReset sb   explDestroy (sa,sb) ety = explDestroy sa ety >> explDestroy sb ety@@ -173,9 +158,7 @@   {-# INLINE explDestroy #-}   {-# INLINE explExists #-} -instance (Store a, Store b) => Store (a, b) where   type SafeRW (a, b) = (SafeRW a, SafeRW b)-  type Stores (a, b) = (Stores a, Stores b)   explGetUnsafe  (sa,sb) ety = (,) <$> explGetUnsafe sa ety <*> explGetUnsafe sb ety   explGet        (sa,sb) ety = (,) <$> explGet sa ety <*> explGet sb ety   explSet        (sa,sb) ety (wa,wb) = explSet sa ety wa >> explSet sb ety wb@@ -185,11 +168,7 @@   {-# INLINE explSet #-}   {-# INLINE explSetMaybe #-} -instance (GlobalRW a ca, GlobalRW b cb) => GlobalRW (a,b) (ca,cb) where-  explGlobalRead  (sa,sb) = (,) <$> explGlobalRead sa <*> explGlobalRead sb-  explGlobalWrite (sa,sb) (wa,wb) = explGlobalWrite sa wa >> explGlobalWrite sb wb-  {-# INLINE explGlobalRead #-}-  {-# INLINE explGlobalWrite #-}+instance (GlobalStore a, GlobalStore b) => GlobalStore (a,b) where  -- (,,) instance (Component a, Component b, Component c) => Component (a,b,c) where@@ -198,11 +177,11 @@   {-# INLINE getStore #-}   getStore = (,,) <$> getStore <*> getStore <*> getStore -instance (Initializable a, Initializable b, Initializable c) => Initializable (a,b,c) where+instance (Store a, Store b, Store c) => Store (a,b,c) where   type InitArgs (a, b, c) = (InitArgs a, InitArgs b, InitArgs c)+  type Stores (a, b, c) = (Stores a, Stores b, Stores c)   initStoreWith (aa, ab, ac) = (,,) <$> initStoreWith aa <*> initStoreWith ab <*> initStoreWith ac -instance (HasMembers a, HasMembers b, HasMembers c) => HasMembers (a,b,c) where   explMembers (sa,sb,sc) = explMembers sa >>= U.filterM (explExists sb) >>= U.filterM (explExists sc)   explReset   (sa,sb,sc) = explReset sa >> explReset sb >> explReset sc   explDestroy (sa,sb,sc) ety = explDestroy sa ety >> explDestroy sb ety >> explDestroy sc ety@@ -212,9 +191,7 @@   {-# INLINE explDestroy #-}   {-# INLINE explExists #-} -instance (Store a, Store b, Store c) => Store (a, b, c) where   type SafeRW (a, b, c) = (SafeRW a, SafeRW b, SafeRW c)-  type Stores (a, b, c) = (Stores a, Stores b, Stores c)   explGetUnsafe  (sa,sb,sc) ety = (,,) <$> explGetUnsafe sa ety <*> explGetUnsafe sb ety <*> explGetUnsafe sc ety   explGet        (sa,sb,sc) ety = (,,) <$> explGet sa ety <*> explGet sb ety <*> explGet sc ety   explSet        (sa,sb,sc) ety (wa,wb,wc) = explSet sa ety wa >> explSet sb ety wb >> explSet sc ety wc@@ -224,8 +201,4 @@   {-# INLINE explSet #-}   {-# INLINE explSetMaybe #-} -instance (GlobalRW a ca, GlobalRW b cb, GlobalRW c cc) => GlobalRW (a,b,c) (ca,cb,cc) where-  explGlobalRead  (sa,sb,sc) = (,,) <$> explGlobalRead sa <*> explGlobalRead sb <*> explGlobalRead sc-  explGlobalWrite (sa,sb,sc) (wa,wb,wc) = explGlobalWrite sa wa >> explGlobalWrite sb wb >> explGlobalWrite sc wc-  {-# INLINE explGlobalRead #-}-  {-# INLINE explGlobalWrite #-}+instance (GlobalStore a, GlobalStore b, GlobalStore c) => GlobalStore (a,b,c) where

@@ -28,7 +28,7 @@ import Apecs.System  -- | Initializes a store with (), useful since most stores have () as their initialization argument-initStore :: (Initializable s, InitArgs s ~ ()) => IO s+initStore :: (Store s, InitArgs s ~ ()) => IO s initStore = initStoreWith ()  unEntity :: Entity a -> Int@@ -52,7 +52,7 @@  -- | Writes the given components to a new entity, and yields that entity {-# INLINE newEntity #-}-newEntity :: (IsRuntime c, Has w c, Has w EntityCounter)+newEntity :: (Store (Storage c), Has w c, Has w EntityCounter)           => c -> System w (Entity c) newEntity c = do ety <- nextEntity                  set ety c

@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}  {-# OPTIONS_GHC -w #-} @@ -22,13 +23,15 @@  type Vec = (Double, Double) +---+ newtype Position = Position Vec deriving (Arbitrary, Eq, Show) instance Component Position where   type Storage Position = S.Logger (S.FromPure Members) (S.Map Position)  newtype CachePos = CachePos Vec deriving (Arbitrary, Eq, Show) instance Component CachePos where-  type Storage CachePos = S.Map CachePos+  type Storage CachePos = S.Cache 1 (S.Map CachePos)   newtype Velocity = Velocity Vec deriving (Arbitrary, Eq, Show)@@ -51,7 +54,7 @@  newtype RandomEntity a = RandomEntity (Entity a) deriving (Eq, Show) instance Arbitrary (RandomEntity a) where-  arbitrary = RandomEntity . Entity <$> arbitrary+  arbitrary = RandomEntity . Entity . abs <$> arbitrary  newtype W1 c = W1 {w1c1 :: (Storage c)} instance Component c => Has (W1 c) c where getStore = System $ asks w1c1@@ -60,6 +63,17 @@ instance (Component a, Component b) => Has (W2 a b) a where getStore = System $ asks w2c1 instance (Component a, Component b) => Has (W2 a b) b where getStore = System $ asks w2c2 +counter :: [CachePos] -> CachePos -> Property+counter cs c = monadicIO $ run f >>= assert+  where+    f = do+      w :: W2 CachePos EntityCounter <- W2 <$> initStore <*> initCounter+      runWith w $ do+        forM_ cs newEntity+        e <- newEntity c+        Safe r <- get e+        return (r == Just c)+ getSetPos :: [(RandomEntity Position, Position)] -> RandomEntity Position -> Position -> Property getSetPos cs (RandomEntity e) p = monadicIO $ run f >>= assert   where@@ -105,3 +119,4 @@   quickCheck getSetPos   quickCheck getSetVCPos   quickCheck cmapVP+  quickCheck counter

@@ -239,23 +239,21 @@ For simplicity's sake, I chose to arrange them randomly in a square, with area proportional to the number of selected units. ```haskell handleEvent (SDL.MouseButtonEvent (SDL.MouseButtonEventData _ SDL.Pressed _ SDL.ButtonRight _ (P (V2 px py)))) = do-  sl :: Slice Selected <- slice All-  let r = (*3) . subtract 1 . sqrt . fromIntegral$ sliceSize sl+  sl :: Slice Selected <- owners+  let r = (*3) . subtract 1 . sqrt . fromIntegral$ S.size sl -  sliceForM_ sl $ \e -> do+  S.forM_ sl $ \e -> do     dx <- liftIO$ randomRIO (-r,r)     dy <- liftIO$ randomRIO (-r,r)     set e (Target (V2 (fromIntegral px+dx) (fromIntegral py+dy)))  handleEvent _ = return () ```-`slice` performs a query, and returns a `Slice`, which is just a list of entities.-The only query we can currently perform is `All`, which returns all owners of the specified component.-Other queries can be performed by using a more elaborate `Storage` type, but that's for a later tutorial.+`owners` returns a `Slice` of all members that have that particular component.+A `Slice` is a list of entities. The reason we need a slice instead of a map is that we need to know the amount of selected units.- There's a few more interesting functions here.-`sliceForM_` monadically iteraters over a `Slice`.+`S.forM_` monadically iteraters over a `Slice`. `set entity component` then explicitly writes a component for an entity, overwriting whatever might have been there.  #### Rendering