apecs 0.2.4.1 → 0.2.4.2
raw patch · 5 files changed
+68/−26 lines, 5 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Apecs.Slice: elem :: Entity c -> Slice c -> Bool
+ Apecs.Slice: elem' :: Entity a -> Slice b -> Bool
- Apecs.Types: class Store s where type Stores s type SafeRW s explReset s = do { sl <- explMembers s; mapM_ (explDestroy s) sl } explImapM_ s ma = liftIO (explMembers s) >>= mapM_ ma . toList explImapM s ma = liftIO (explMembers s) >>= mapM ma . toList explModify s ety f = do { etyExists <- explExists s ety; when etyExists $ explGetUnsafe s ety >>= explSet s ety . f } explCmap s f = explMembers s >>= mapM_ (\ ety -> explModify s ety f) explCmapM_ s sys = do { sl <- liftIO $ explMembers s; forM_ sl $ \ ety -> do { x :: Stores s <- liftIO $ explGetUnsafe s ety; sys x } } explCimapM_ s sys = do { sl <- liftIO $ explMembers s; forM_ sl $ \ ety -> do { x :: Stores s <- liftIO $ explGetUnsafe s ety; sys (ety, x) } } explCmapM s sys = do { sl <- liftIO $ explMembers s; for (toList sl) $ \ ety -> do { x :: Stores s <- liftIO $ explGetUnsafe s ety; sys x } } explCimapM s sys = do { sl <- liftIO $ explMembers s; for (toList sl) $ \ ety -> do { x :: Stores s <- liftIO $ explGetUnsafe s ety; sys (ety, x) } } where {
+ Apecs.Types: class Store s where type Stores s type SafeRW s explExists s n = do { mems <- explMembers s; return $ elem n mems } explReset s = do { sl <- explMembers s; mapM_ (explDestroy s) sl } explImapM_ s ma = liftIO (explMembers s) >>= mapM_ ma . toList explImapM s ma = liftIO (explMembers s) >>= mapM ma . toList explModify s ety f = do { etyExists <- explExists s ety; when etyExists $ explGetUnsafe s ety >>= explSet s ety . f } explCmap s f = explMembers s >>= mapM_ (\ ety -> explModify s ety f) explCmapM_ s sys = do { sl <- liftIO $ explMembers s; forM_ sl $ \ ety -> do { x :: Stores s <- liftIO $ explGetUnsafe s ety; sys x } } explCimapM_ s sys = do { sl <- liftIO $ explMembers s; forM_ sl $ \ ety -> do { x :: Stores s <- liftIO $ explGetUnsafe s ety; sys (ety, x) } } explCmapM s sys = do { sl <- liftIO $ explMembers s; for (toList sl) $ \ ety -> do { x :: Stores s <- liftIO $ explGetUnsafe s ety; sys x } } explCimapM s sys = do { sl <- liftIO $ explMembers s; for (toList sl) $ \ ety -> do { x :: Stores s <- liftIO $ explGetUnsafe s ety; sys (ety, x) } } where {
Files
- apecs.cabal +1/−1
- src/Apecs/Slice.hs +10/−0
- src/Apecs/System.hs +1/−2
- src/Apecs/Types.hs +11/−7
- test/Main.hs +45/−16
apecs.cabal view
@@ -1,5 +1,5 @@ name: apecs-version: 0.2.4.1+version: 0.2.4.2 homepage: https://github.com/jonascarpay/apecs#readme license: BSD3 license-file: LICENSE
src/Apecs/Slice.hs view
@@ -20,6 +20,16 @@ size :: Slice a -> Int size (Slice vec) = U.length vec +-- | Checks whether an entity is in a slice+{-# INLINE elem #-}+elem :: Entity c -> Slice c -> Bool+elem = elem'++-- | More polymorphic version of 'elem'+{-# INLINE elem' #-}+elem' :: Entity a -> Slice b -> Bool+elem' (Entity e) (Slice sl) = U.elem e sl+ -- | Tests whether a slice is empty (O(1)) {-# INLINE null #-} null :: Slice a -> Bool
src/Apecs/System.hs view
@@ -188,6 +188,5 @@ -- | Modifies a global value {-# INLINE modifyGlobal #-} modifyGlobal :: forall w c. (Has w c, GlobalStore (Storage c)) => (c -> c) -> System w ()-modifyGlobal f = do s :: Storage c <- getStore- liftIO$ explModify s 0 f+modifyGlobal f = readGlobal >>= writeGlobal . f
src/Apecs/Types.hs view
@@ -42,24 +42,28 @@ -- | Return type for safe reads writes to the store type SafeRW s + -- Initialize the store with its initialization arguments.+ initStore :: IO s+ -- | Retrieves a component from the store- explGet :: s -> Int -> IO (SafeRW s)+ explGet :: s -> Int -> IO (SafeRW s) -- | Writes a component- explSet :: s -> Int -> Stores s -> IO ()+ 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- explExists :: s -> Int -> IO Bool+ explExists :: s -> Int -> IO Bool+ explExists s n = do+ mems <- explMembers s+ return $ U.elem n mems+ -- | Returns an unboxed vector of member indices explMembers :: s -> IO (U.Vector Int) -- | Unsafe index to the store. What happens if the component does not exist is left undefined. explGetUnsafe :: s -> Int -> IO (Stores s) -- | Either writes or deletes a component- explSetMaybe :: s -> Int -> SafeRW s -> IO ()-- -- Initialize the store with its initialization arguments.- initStore :: IO s+ explSetMaybe :: s -> Int -> SafeRW s -> IO () -- | Removes all components. -- Equivalent to calling @explDestroy@ on each member
test/Main.hs view
@@ -14,6 +14,7 @@ import qualified Data.IntSet as S import qualified Data.Vector.Unboxed as U import Data.IORef+import Data.List (sort) import Apecs import Apecs.Types@@ -52,8 +53,8 @@ instance Component MapInt where type Storage MapInt = Map MapInt makeWorld "SetGetMI" [''MapInt] -setGetProp :: Scramble MapInt -> RandomEntity MapInt -> MapInt -> Property-setGetProp scr (RandomEntity re) rw = assertSys initSetGetMI $ do+prop_setGet :: Scramble MapInt -> RandomEntity MapInt -> MapInt -> Property+prop_setGet scr (RandomEntity re) rw = assertSys initSetGetMI $ do scramble scr set re rw Safe r :: Safe MapInt <- get re@@ -64,15 +65,15 @@ instance Component CacheInt where type Storage CacheInt = Cache 2 (Map CacheInt) makeWorld "SetGetCI" [''CacheInt] -setGetPropC :: Scramble CacheInt -> RandomEntity CacheInt -> CacheInt -> Property-setGetPropC scr (RandomEntity re) rw = assertSys initSetGetCI $ do+prop_setGetCached :: Scramble CacheInt -> RandomEntity CacheInt -> CacheInt -> Property+prop_setGetCached scr (RandomEntity re) rw = assertSys initSetGetCI $ do scramble scr set re rw Safe r :: Safe CacheInt <- get re return (r == Just rw) -listMembersIsSlice :: Scramble CacheInt -> Property-listMembersIsSlice scr = assertSys initSetGetCI $ do+prop_sliceIsMembersLog :: Scramble CacheInt -> Property+prop_sliceIsMembersLog scr = assertSys initSetGetCI $ do scramble scr es :: [Entity CacheInt] <- listAllE sl :: Slice CacheInt <- owners@@ -89,14 +90,33 @@ makeWorld "Tuples" [''T1, ''T2, ''T3] -setGetTuple :: (T1, T2, T3) -> Inserts (T1, T2, T3) -> Property-setGetTuple w@(T1 n1, T2 n2, T3 n3) ws = assertSys initTuples $ do+prop_setGetTuple :: (T1, T2, T3) -> Inserts (T1, T2, T3) -> Property+prop_setGetTuple w@(T1 n1, T2 n2, T3 n3) ws = assertSys initTuples $ do e <- newEntity w insertAll ws cmap $ \(T1 n) -> T1 (n+1) Safe (r1, r2, r3) <- get e return $ r1 == Just (T1 $ n1+1) && r2 == Just (T2 n2) && r3 == Just (T3 n3) +prop_flipTuple :: Scramble T1 -> Scramble T2 -> Scramble T3 -> Scramble (T1,T2,T3) -> Property+prop_flipTuple s1 s2 s3 s = assertSys initTuples $ do+ scramble s1; scramble s2; scramble s3; scramble s+ s1 :: Slice (T1,T2) <- owners+ s2 :: Slice (T2,T1) <- owners+ let sorted = sort . fmap unEntity . Sl.toList+ return$ sorted s1 == sorted s2++prop_membership :: Int -> Scramble T1 -> Scramble T2 -> Scramble T3 -> Scramble (T1,T2,T3) -> Property+prop_membership ety s1 s2 s3 s = assertSys initTuples $ do+ scramble s1; scramble s2; scramble s3; scramble s+ let e1 = (Entity ety :: Entity T1)+ e123 = (Entity ety :: Entity (T1, T2, T3))+ sl1 <- owners+ ex1 <- exists e1+ sl123 <- owners+ ex123 <- exists e123+ return$ Sl.elem e1 sl1 == ex1 && Sl.elem e123 sl123 == ex123+ -- This Log should be able to track the members of the underlying store newtype Members c = Members S.IntSet instance PureLog Members c where@@ -110,8 +130,8 @@ makeWorld "LoggerProp" [''Logged] -loggerProp :: Scramble Logged -> Property-loggerProp s = assertSys initLoggerProp $ do+prop_logger :: Scramble Logged -> Property+prop_logger s = assertSys initLoggerProp $ do scramble s Slice sl :: Slice Logged <- owners FromPure ref :: FromPure Members Logged <- getLog@@ -119,10 +139,19 @@ return (sl == U.fromList (S.toList set)) +newtype G = G Bool deriving (Eq, Show)+instance Monoid G where+ mempty = G False+ mappend (G x) (G y) = G (x || y)+instance Component G where+ type Storage G = Global G -main = do- quickCheck setGetProp- quickCheck setGetTuple- quickCheck setGetPropC- quickCheck loggerProp- quickCheck listMembersIsSlice+makeWorld "GProp" [''G]++prop_global = assertSys initGProp $ do+ modifyGlobal $ \(G x) -> G (not x)+ G x <- readGlobal+ return $ x == True++return []+main = $quickCheckAll