feat: new monadic Query design

aztecs.cabal

@@ -66,6 +66,7 @@ library
         base >=4.2 && <5,
         containers >=0.6,
         mtl >=2,
+        free,
         vector >=0.12
 
 test-suite aztecs-test
@@ -80,8 +81,7 @@ test-suite aztecs-test
         containers >=0.6,
         deepseq >=1,
         hspec >=2,
-        QuickCheck >=2,
-        vector >=0.12
+        QuickCheck >=2
 
 benchmark aztecs-bench
     type:             exitcode-stdio-1.0
@@ -93,5 +93,4 @@ benchmark aztecs-bench
         base >=4.2 && <5,
         aztecs,
         criterion >=1,
-        deepseq >=1,
-        vector >=0.12
+        deepseq >=1

bench/Bench.hs

@@ -3,15 +3,17 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecursiveDo #-}
 
 import Aztecs.ECS
 import qualified Aztecs.ECS.Query as Q
 import Aztecs.ECS.World
 import qualified Aztecs.ECS.World as W
 import Control.DeepSeq
+import Control.Monad.Fix
 import Criterion.Main
-import Data.Functor.Identity (Identity (runIdentity))
-import Data.Vector (Vector)
+import Data.Functor.Identity
 import GHC.Generics
 
 newtype Position = Position Int deriving (Show, Generic, NFData)
@@ -22,13 +24,21 @@ newtype Velocity = Velocity Int deriving (Show, Generic, NFData)
 
 instance (Monad m) => Component m Velocity
 
-move :: (Monad m) => Query m Position
-move = queryMapWith (\(Velocity v) (Position p) -> (Position $ p + v)) query
+move :: (Applicative f, Monad m) => Query f m (f Position)
+move = do
+  vs <- Q.query
+  queryMap $ \ps -> (\(Velocity v) (Position p) -> Position $ p + v) <$> vs <*> ps
 
-run :: Query Identity Position -> World Identity -> Vector Position
+moveRec :: (Applicative f, MonadFix m) => Query f m (f Position)
+moveRec = mdo
+  vs <- queryMap $ \vs' -> (\(Position p) (Velocity v) -> Velocity $ p + v) <$> ps <*> vs'
+  ps <- queryMap $ \ps' -> (\(Velocity v) (Position p) -> Position $ p + v) <$> vs <*> ps'
+  return ps
+
+run :: (forall f. (Applicative f) => Query f Identity (f Position)) -> World Identity -> [Position]
 run q = (\(a, _, _) -> a) . runIdentity . Q.runQuery q . entities
 
-runSys :: Query Identity Position -> World Identity -> Vector Position
+runSys :: (forall f. (Applicative f) => Query f Identity (f Position)) -> World Identity -> [Position]
 runSys q = fst . runIdentity . runAccess (system $ runQuery q)
 
 main :: IO ()
@@ -37,5 +47,7 @@ main = do
       !w = foldr (const go) W.empty [0 :: Int .. 10000]
   defaultMain
     [ bench "iter" $ nf (run move) w,
-      bench "iterSystem" $ nf (runSys move) w
+      bench "iterSystem" $ nf (runSys move) w,
+      bench "iterRec" $ nf (run moveRec) w,
+      bench "iterRecSystem" $ nf (runSys moveRec) w
     ]

src/Aztecs/ECS.hs

@@ -59,19 +59,11 @@ module Aztecs.ECS
     MonoidDynamicBundle (..),
     Component (..),
     EntityID,
-    Query,
+    Query (..),
+    entity,
     query,
-    queryMaybe,
     queryMap,
-    queryMapM,
-    queryMapWith,
-    queryMapWith_,
-    queryMapWithM,
     queryMapAccum,
-    queryMapAccumM,
-    queryMapWithAccum,
-    queryMapWithAccumM,
-    DynamicQueryF (..),
     QueryFilter,
     with,
     without,
@@ -102,20 +94,12 @@ import Aztecs.ECS.Observer
     observerGlobal,
   )
 import Aztecs.ECS.Query
-  ( DynamicQueryF (..),
-    Query,
+  ( Query (..),
     QueryFilter,
+    entity,
     query,
     queryMap,
     queryMapAccum,
-    queryMapAccumM,
-    queryMapM,
-    queryMapWith,
-    queryMapWithAccum,
-    queryMapWithAccumM,
-    queryMapWithM,
-    queryMapWith_,
-    queryMaybe,
     with,
     without,
   )

src/Aztecs/ECS/Component.hs

@@ -21,14 +21,13 @@ import Aztecs.ECS.Component.Internal (ComponentID (..))
 import Aztecs.ECS.Entity
 import Aztecs.ECS.World.Storage
 import Data.Typeable
-import Data.Vector (Vector)
 
 -- | Component that can be stored in the `World`.
 class (Monad m, Typeable a, Storage a (StorageT a)) => Component m a where
   -- | `Storage` of this component.
   type StorageT a
 
-  type StorageT a = Vector a
+  type StorageT a = [a]
 
   -- | Lifecycle hook called when a component is inserted.
   componentOnInsert :: EntityID -> a -> Access m ()

src/Aztecs/ECS/Observer.hs

@@ -39,7 +39,6 @@ import Control.Monad.State
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Typeable
-import Data.Vector (Vector)
 
 -- | The kind of observer - either entity-specific or global.
 data ObserverKind m e
@@ -64,7 +63,7 @@ instance Show (Observer m e) where
   show o = "Observer { kind = " ++ show (observerKind o) ++ ", id = " ++ show (observerId o) ++ " }"
 
 instance (Monad m, Typeable m, Event e) => Component m (Observer m e) where
-  type StorageT (Observer m e) = Vector (Observer m e)
+  type StorageT (Observer m e) = [Observer m e]
 
   componentOnInsert ownerEntity o = Access $ do
     !w <- get