packages feed

aztecs 0.10.0 → 0.11.0

raw patch · 40 files changed

+1060/−2749 lines, 40 filesdep −lineardep −paralleldep ~basenew-component:exe:ecs

Dependencies removed: linear, parallel

Dependency ranges changed: base

Files

aztecs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name:          aztecs-version:       0.10.0+version:       0.11.0 license:       BSD-3-Clause license-file:  LICENSE maintainer:    matt@hunzinger.me@@ -25,48 +25,23 @@  library     exposed-modules:-        Aztecs         Aztecs.ECS         Aztecs.ECS.Access-        Aztecs.ECS.Access.Class         Aztecs.ECS.Component         Aztecs.ECS.Entity         Aztecs.ECS.Query-        Aztecs.ECS.Query.Class         Aztecs.ECS.Query.Dynamic-        Aztecs.ECS.Query.Dynamic.Class-        Aztecs.ECS.Query.Dynamic.Reader-        Aztecs.ECS.Query.Dynamic.Reader.Class-        Aztecs.ECS.Query.Reader-        Aztecs.ECS.Query.Reader.Class         Aztecs.ECS.System-        Aztecs.ECS.System.Class-        Aztecs.ECS.System.Dynamic.Class-        Aztecs.ECS.System.Dynamic.Reader.Class-        Aztecs.ECS.System.Reader.Class         Aztecs.ECS.View         Aztecs.ECS.World         Aztecs.ECS.World.Archetype         Aztecs.ECS.World.Archetypes         Aztecs.ECS.World.Bundle-        Aztecs.ECS.World.Bundle.Class         Aztecs.ECS.World.Bundle.Dynamic-        Aztecs.ECS.World.Bundle.Dynamic.Class         Aztecs.ECS.World.Components         Aztecs.ECS.World.Entities         Aztecs.ECS.World.Storage         Aztecs.ECS.World.Storage.Dynamic-        Aztecs.Asset-        Aztecs.Asset.AssetLoader-        Aztecs.Asset.AssetLoader.Class-        Aztecs.Asset.AssetServer-        Aztecs.Asset.Class-        Aztecs.Camera-        Aztecs.Hierarchy-        Aztecs.Input-        Aztecs.Time-        Aztecs.Transform-        Aztecs.Window      hs-source-dirs:   src     default-language: Haskell2010@@ -75,10 +50,17 @@         base >=4.2 && <5,         containers >=0.6,         deepseq >=1,-        linear >=1,         mtl >=2,-        parallel >=3,         stm >=2++executable ecs+    main-is:          examples/ECS.hs+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base,+        aztecs,+        deepseq >=1  test-suite aztecs-test     type:             exitcode-stdio-1.0
bench/Bench.hs view
@@ -20,14 +20,14 @@  instance Component Velocity -query :: Query Position-query = Q.fetch & Q.adjust (\(Velocity v) (Position p) -> Position $ p + v)+q :: Query Position+q = fetch & zipFetchMap (\(Velocity v) (Position p) -> Position $ p + v) -run :: Query Position -> World -> [Position]-run q = fst . runIdentity . Q.map q . entities+run :: World -> [Position]+run = fst . runIdentity . Q.query q . entities  main :: IO () main = do   let go wAcc = snd $ W.spawn (bundle (Position 0) <> bundle (Velocity 1)) wAcc       !w = foldr (const go) W.empty [0 :: Int .. 10000]-  defaultMain [bench "iter" $ nf (run query) w]+  defaultMain [bench "iter" $ nf run w]
+ examples/ECS.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Main where++import Aztecs.ECS+import Control.DeepSeq+import Control.Monad+import Control.Monad.IO.Class+import Data.Function+import GHC.Generics++newtype Position = Position Int deriving (Show, Generic, NFData)++instance Component Position++newtype Velocity = Velocity Int deriving (Show, Generic, NFData)++instance Component Velocity++move :: (Monad m) => QueryT m Position+move = fetch & zipFetchMap (\(Velocity v) (Position p) -> Position $ p + v)++run :: SystemT IO ()+run = do+  positions <- query move+  liftIO $ print positions++app :: AccessT IO ()+app = do+  _ <- spawn $ bundle (Position 0) <> bundle (Velocity 1)+  forever $ system run++main :: IO ()+main = runAccessT_ app
− src/Aztecs.hs 
@@ -1,88 +0,0 @@--- | Aztecs is a type-safe and friendly ECS for games and more.------ An ECS is a modern approach to organizing your application state as a database,--- providing patterns for data-oriented design and parallel processing.------ The ECS architecture is composed of three main concepts:------ === Entities--- An entity is an object comprised of zero or more components.--- In Aztecs, entities are represented by their `EntityID`, a unique identifier.------ === Components--- A `Component` holds the data for a particular aspect of an entity.--- For example, a zombie entity might have a @Health@ and a @Transform@ component.------ > newtype Position = Position Int deriving (Show)--- > instance Component Position--- >--- > newtype Velocity = Velocity Int deriving (Show)--- > instance Component Velocity------ === Systems--- A `System` is a pipeline that processes entities and their components.--- Systems in Aztecs either run in sequence or in parallel automatically based on the components they access.------ Systems can access game state in two ways:------ ==== Access--- An `Access` can be queued for full access to the `World`, after a system is complete.--- `Access` allows for spawning, inserting, and removing components.------ > setup :: System  () ()--- > setup = S.queue . const . A.spawn_ $ bundle (Position 0) <> bundle (Velocity 1)------ ==== Queries--- A `Query` can read and write matching components.------ > move :: System  () ()--- > move =--- >  S.map--- >    ( proc () -> do--- >        Velocity v <- Q.fetch -< ()--- >        Position p <- Q.fetch -< ()--- >        Q.set -< Position $ p + v--- >    )--- >    >>> S.run print------ Finally, systems can be run on a `World` to produce a result.------ > main :: IO ()--- > main = runSystem_ $ setup >>> S.forever move-module Aztecs-  ( module Aztecs.ECS,-    asset,-    load,-    Camera (..),-    CameraTarget (..),-    Key (..),-    KeyboardInput (..),-    isKeyPressed,-    wasKeyPressed,-    wasKeyReleased,-    MouseInput (..),-    Time (..),-    Transform (..),-    Transform2D,-    transform2d,-    Size (..),-    Size2D,-    size2D,-    Window (..),-  )-where--import Aztecs.Asset (asset, load)-import Aztecs.Camera-import Aztecs.ECS-import Aztecs.Input-  ( Key (..),-    KeyboardInput (..),-    MouseInput (..),-    isKeyPressed,-    wasKeyPressed,-    wasKeyReleased,-  )-import Aztecs.Time-import Aztecs.Transform-import Aztecs.Window
− src/Aztecs/Asset.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : Aztecs.Asset--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Asset-  ( AssetId (..),-    AssetServer (..),-    MonadAssetLoader (..),-    Asset (..),-    Handle (..),-    lookupAsset,-    setup,-    loadAssets,-    load,-  )-where--import Aztecs.Asset.AssetLoader-import Aztecs.Asset.AssetServer-import Aztecs.Asset.Class
− src/Aztecs/Asset/AssetLoader.hs 
@@ -1,99 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ApplicativeDo #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module      : Aztecs.Asset.AssetLoader--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Asset.AssetLoader-  ( AssetLoader,-    AssetLoaderT (..),-    MonadAssetLoader (..),-    load,-    loadQuery,-  )-where--import Aztecs.Asset.AssetLoader.Class-import Aztecs.Asset.AssetServer-import Aztecs.Asset.Class-import Aztecs.ECS-import Aztecs.ECS.Query (QueryT (..))-import qualified Aztecs.ECS.Query as Q-import Aztecs.ECS.Query.Dynamic (DynamicQueryT (DynamicQuery, runDynQuery))-import qualified Aztecs.ECS.System as S-import Control.Concurrent-import Control.Monad.Identity-import Control.Monad.State.Strict-import Control.Monad.Writer-import Data.IORef-import qualified Data.Map.Strict as Map---- | @since 0.9-type AssetLoader a o = AssetLoaderT a Identity o---- | Asset loader monad.------ @since 0.9-newtype AssetLoaderT a m o = AssetLoaderT-  { -- | State of the asset loader.-    ---    -- @since 0.9-    unAssetLoader :: StateT (AssetServer a) m o-  }-  deriving newtype (Functor, Applicative, Monad)---- | @since 0.9-instance (Monad m, Asset a) => MonadAssetLoader a (AssetLoaderT a m) where-  asset path cfg = AssetLoaderT $ do-    server <- get-    let assetId = nextAssetId server-        go = do-          v <- newIORef Nothing-          _ <- forkIO $ do-            a <- loadAsset path cfg-            writeIORef v (Just a)-          return v-    put $-      server-        { loadingAssets = Map.insert assetId (Left go) (loadingAssets server),-          nextAssetId = AssetId (unAssetId assetId + 1)-        }-    return $ Handle assetId---- | Query to load assets.------ @since 0.9-loadQuery :: (Asset a) => AssetLoader a o -> Query o-loadQuery a =-  -- TODO-  Query $ \cs ->-    let q =-          Q.adjustM-            ( \_ server -> do-                let (o, server') = runState (unAssetLoader a) server-                tell [o]-                return server'-            )-            (pure ())-        (rws, cs', dynQ) = runQuery q cs-     in ( rws,-          cs',-          DynamicQuery $ \arch ->-            let ((_, arch'), os) = runWriter $ runDynQuery dynQ arch in return (os, arch')-        )---- | System to load assets.------ @since 0.9-load :: (MonadSystem Query s, Asset a) => AssetLoader a o -> s o-load a = S.mapSingle $ loadQuery a
− src/Aztecs/Asset/AssetLoader/Class.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}---- |--- Module      : Aztecs.Asset.AssetLoader.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Asset.AssetLoader.Class (MonadAssetLoader (..)) where--import Aztecs.Asset.AssetServer-import Aztecs.Asset.Class---- | Monadic interface for loading assets.------ @since 0.9-class MonadAssetLoader a m | m -> a where-  -- | Load an asset from a file path with a configuration.-  ---  -- @since 0.9-  asset :: FilePath -> AssetConfig a -> m (Handle a)
− src/Aztecs/Asset/AssetServer.hs 
@@ -1,142 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}---- |--- Module      : Aztecs.Asset.AssetServer--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Asset.AssetServer-  ( AssetId (..),-    Handle (..),-    AssetServer (..),-    assetServer,-    lookupAsset,-    setup,-    loadAssets,-    loadAssetServer,-  )-where--import Aztecs.ECS-import qualified Aztecs.ECS.Access as A-import qualified Aztecs.ECS.Query as Q-import qualified Aztecs.ECS.System as S-import Control.DeepSeq-import Control.Monad-import Control.Monad.IO.Class-import Data.Data-import Data.Foldable-import Data.IORef-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import GHC.Generics---- | Unique identifier for an asset.------ @since 0.9-newtype AssetId = AssetId-  { -- | Unique integer identifier.-    ---    -- @since 0.9-    unAssetId :: Int-  }-  deriving (Eq, Ord, Show)---- | Asset server.------ @since 0.9-data AssetServer a = AssetServer-  { -- | Loaded assets.-    ---    -- @since 0.9-    assetServerAssets :: !(Map AssetId a),-    -- | Assets currently being loaded.-    ---    -- @since 0.9-    loadingAssets :: !(Map AssetId (Either (IO (IORef (Maybe a))) (IORef (Maybe a)))),-    -- | Next unique asset identifier.-    ---    -- @since 0.9-    nextAssetId :: !AssetId-  }-  deriving (Generic)---- | @since 0.9-instance (Typeable a) => Component (AssetServer a)---- | @since 0.9-instance NFData (AssetServer a) where-  rnf = rwhnf---- | Empty asset server.------ @since 0.9-assetServer :: AssetServer a-assetServer =-  AssetServer-    { assetServerAssets = Map.empty,-      loadingAssets = Map.empty,-      nextAssetId = AssetId 0-    }---- | Handle to an asset.------ @since 0.9-newtype Handle a = Handle-  { -- | Asset ID.-    ---    -- @since 0.9-    handleId :: AssetId-  }-  deriving (Eq, Ord, Show)---- | @since 0.9-instance NFData (Handle a) where-  rnf = rwhnf---- | Lookup an asset by its handle.------ @since 0.9-lookupAsset :: Handle a -> AssetServer a -> Maybe a-lookupAsset h server = Map.lookup (handleId h) (assetServerAssets server)---- | Setup the asset server.------ @since 0.9-setup :: forall m b a. (Typeable a, MonadAccess b m) => m ()-setup = A.spawn_ . bundle $ assetServer @a---- | Load any pending assets.------ @since 0.9-loadAssets :: forall a q s m. (Typeable a, QueryF m q, Applicative q, MonadSystem q s, MonadIO m) => s ()-loadAssets = void $ S.map (Q.adjustM (\_ s -> loadAssetServer @m @a s) (pure ())) -- TODO Q.setM---- | Load any pending assets in an `AssetServer`.------ @since 0.9-loadAssetServer :: (MonadIO m) => AssetServer a -> m (AssetServer a)-loadAssetServer server =-  let go (aId, v) acc = do-        case v of-          Right r -> do-            maybeSurface <- readIORef r-            case maybeSurface of-              Just surface ->-                return-                  acc-                    { assetServerAssets = Map.insert aId surface (assetServerAssets acc),-                      loadingAssets = Map.delete aId (loadingAssets acc)-                    }-              Nothing -> return acc-          Left f -> do-            v' <- f-            return $ acc {loadingAssets = Map.insert aId (Right v') (loadingAssets server)}-   in liftIO . foldrM go server . Map.toList $ loadingAssets server
− src/Aztecs/Asset/Class.hs 
@@ -1,27 +0,0 @@-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : Aztecs.Asset.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Asset.Class (Asset (..)) where--import Data.Data---- | Loadable asset.------ @since 0.9-class (Typeable a) => Asset a where-  -- | Configuration for loading an asset.-  ---  -- @since 0.9-  type AssetConfig a--  -- | Load an asset from a file path with a configuration.-  ---  -- @since 0.9-  loadAsset :: FilePath -> AssetConfig a -> IO a
− src/Aztecs/Camera.hs 
@@ -1,78 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeApplications #-}---- |--- Module      : Aztecs.Camera--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Camera-  ( Camera (..),-    CameraTarget (..),-    addCameraTargets,-  )-where--import Aztecs.ECS-import qualified Aztecs.ECS.Access as A-import qualified Aztecs.ECS.Query.Reader as Q-import qualified Aztecs.ECS.System as S-import Aztecs.Window-import Control.DeepSeq-import GHC.Generics-import Linear---- | Camera component.------ @since 0.9-data Camera = Camera-  { -- | Camera viewport size.-    ---    -- @since 0.9-    cameraViewport :: !(V2 Int),-    -- | Camera scale factor.-    ---    -- @since 0.9-    cameraScale :: !(V2 Float)-  }-  deriving (Show, Generic, NFData)---- | @since 0.9-instance Component Camera---- | Camera target component.------ @since 0.9-newtype CameraTarget = CameraTarget-  { -- | This camera's target window.-    ---    -- @since 0.9-    cameraTargetWindow :: EntityID-  }-  deriving (Eq, Show, Generic, NFData)---- | @since 0.9-instance Component CameraTarget---- | Add `CameraTarget` components to entities with a new `Draw` component.------ @since 0.9-addCameraTargets ::-  ( Applicative qr,-    QueryReaderF qr,-    DynamicQueryReaderF qr,-    MonadReaderSystem qr s,-    MonadAccess b m-  ) =>-  s (m ())-addCameraTargets = do-  windows <- S.all ((,) <$> Q.entity <*> Q.fetch @_ @Window)-  newCameras <- S.filter ((,) <$> Q.entity <*> Q.fetch @_ @Camera) (without @CameraTarget)-  let go = case windows of-        (windowEId, _) : _ -> mapM_ (\(eId, _) -> A.insert eId . bundle $ CameraTarget windowEId) newCameras-        _ -> return ()-  return go
src/Aztecs/ECS.hs view
@@ -21,80 +21,32 @@ -- -- === Systems -- A `System` is a pipeline that processes entities and their components.--- Systems in Aztecs either run in sequence or in parallel automatically based on the components they access.------ Systems can access game state in two ways:------ ==== Access--- An `Access` can be queued for full access to the `World`, after a system is complete.--- `Access` allows for spawning, inserting, and removing components.------ > setup :: System  () ()--- > setup = S.queue . const . A.spawn_ $ bundle (Position 0) <> bundle (Velocity 1)------ ==== Queries--- A `Query` can read and write matching components.------ > move :: System  () ()--- > move =--- >  S.map--- >    ( proc () -> do--- >        Velocity v <- Q.fetch -< ()--- >        Position p <- Q.fetch -< ()--- >        Q.set -< Position $ p + v--- >    )--- >    >>> S.run print------ Finally, systems can be run on a `World` to produce a result.------ > main :: IO ()--- > main = runSystem_ $ setup >>> S.forever move module Aztecs.ECS-  ( Access,+  ( module Aztecs.ECS.System,+    module Aztecs.ECS.Query,+    Access,     AccessT,-    MonadAccess,     runAccessT,     runAccessT_,     Bundle,-    MonoidBundle (..),+    bundle,+    fromDynBundle,     DynamicBundle,-    MonoidDynamicBundle (..),+    dynBundle,     Component (..),     EntityID,-    Query,-    QueryT,-    QueryReader,-    QueryReaderF,-    QueryF,-    DynamicQueryReaderF,-    DynamicQueryF,-    QueryFilter,-    with,-    without,-    System,-    SystemT,-    MonadReaderSystem,-    MonadSystem,+    spawn,+    system,+    concurrently,     World,   ) where  import Aztecs.ECS.Access-import Aztecs.ECS.Component (Component (..))-import Aztecs.ECS.Entity (EntityID)-import Aztecs.ECS.Query-  ( DynamicQueryF,-    DynamicQueryReaderF,-    Query,-    QueryF,-    QueryFilter,-    QueryReaderF,-    QueryT,-    with,-    without,-  )-import Aztecs.ECS.Query.Reader (QueryReader)-import Aztecs.ECS.System+import Aztecs.ECS.Component+import Aztecs.ECS.Entity+import Aztecs.ECS.Query hiding (query, querySingle, querySingleMaybe, readQueryEntities)+import Aztecs.ECS.System hiding (concurrently) import Aztecs.ECS.World (World)-import Aztecs.ECS.World.Bundle (Bundle, MonoidBundle (..))-import Aztecs.ECS.World.Bundle.Dynamic (DynamicBundle, MonoidDynamicBundle (..))+import Aztecs.ECS.World.Bundle+import Aztecs.ECS.World.Bundle.Dynamic
src/Aztecs/ECS/Access.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-}@@ -14,35 +15,32 @@ module Aztecs.ECS.Access   ( Access,     AccessT (..),-    MonadAccess (..),+    spawn,+    insert,+    lookup,+    remove,+    despawn,     runAccessT,     runAccessT_,     system,+    concurrently,   ) where -import Aztecs.ECS.Access.Class-import Aztecs.ECS.Query (QueryT (..))-import qualified Aztecs.ECS.Query as Q-import Aztecs.ECS.Query.Dynamic (DynamicQueryT)-import qualified Aztecs.ECS.Query.Dynamic as Q-import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReader)-import qualified Aztecs.ECS.Query.Dynamic.Reader as Q-import Aztecs.ECS.Query.Reader-import Aztecs.ECS.System+import Aztecs.ECS.Component+import Aztecs.ECS.Entity+import Aztecs.ECS.System (SystemT (..), runSystemT)+import qualified Aztecs.ECS.System as S import Aztecs.ECS.World (World (..)) import qualified Aztecs.ECS.World as W-import qualified Aztecs.ECS.World.Archetype as A-import Aztecs.ECS.World.Archetypes (Node (..)) import Aztecs.ECS.World.Bundle-import qualified Aztecs.ECS.World.Entities as E import Control.Concurrent.STM import Control.DeepSeq import Control.Monad.Fix import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.State.Strict-import qualified Data.Foldable as F+import Prelude hiding (lookup)  -- | @since 0.9 type Access = AccessT Identity@@ -73,104 +71,80 @@ runAccessT_ :: (Functor m) => AccessT m a -> m a runAccessT_ a = fmap fst . runAccessT a $ W.empty --- | @since 0.9-instance (Monad m) => MonadAccess Bundle (AccessT m) where-  spawn b = AccessT $ do-    !w <- get-    let !(e, w') = W.spawn b w-    put w'-    return e-  insert e c = AccessT $ do-    !w <- get-    let !w' = W.insert e c w-    put w'-  lookup e = AccessT $ do-    !w <- get-    return $ W.lookup e w-  remove e = AccessT $ do-    !w <- get-    let !(a, w') = W.remove e w-    put w'-    return a-  despawn e = AccessT $ do-    !w <- get-    let !(_, w') = W.despawn e w-    put w'+-- | Spawn an entity with a `Bundle`.+--+-- @since 0.11+spawn :: (Monad m) => Bundle -> AccessT m EntityID+spawn b = AccessT $ do+  !w <- get+  let !(e, w') = W.spawn b w+  put w'+  return e --- | @since 0.9-instance (Monad m) => MonadReaderSystem QueryReader (AccessT m) where-  all q = AccessT $ do-    w <- get-    let (cIds, cs, dynQ) = runQueryReader q . E.components $ entities w-    put w {entities = (entities w) {E.components = cs}}-    unAccessT $ allDyn cIds dynQ-  filter q f = AccessT $ do-    w <- get-    let (cIds, cs, dynQ) = runQueryReader q . E.components $ entities w-        (dynF, cs') = runQueryFilter f cs-    put w {entities = (entities w) {E.components = cs'}}-    let f' n =-          F.all (\cId -> A.member cId $ nodeArchetype n) (filterWith dynF)-            && F.all (\cId -> not (A.member cId $ nodeArchetype n)) (filterWithout dynF)-    unAccessT $ filterDyn cIds dynQ f'+-- | Insert a `Bundle` into an entity.+--+-- @since 0.11+insert :: (Monad m) => EntityID -> Bundle -> AccessT m ()+insert e c = AccessT $ do+  !w <- get+  let !w' = W.insert e c w+  put w' --- | @since 0.9-instance (Monad m) => MonadSystem (QueryT m) (AccessT m) where-  map q = AccessT $ do-    !w <- get-    let (rws, cs, dynQ) = runQuery q . E.components $ entities w-    put w {entities = (entities w) {E.components = cs}}-    unAccessT $ mapDyn (Q.reads rws <> Q.writes rws) dynQ-  mapSingleMaybe q = AccessT $ do-    !w <- get-    let (rws, cs, dynQ) = runQuery q . E.components $ entities w-    put w {entities = (entities w) {E.components = cs}}-    unAccessT $ mapSingleMaybeDyn (Q.reads rws <> Q.writes rws) dynQ-  filterMap q f = AccessT $ do-    !w <- get-    let (rws, cs, dynQ) = runQuery q . E.components $ entities w-        (dynF, cs') = runQueryFilter f cs-    put w {entities = (entities w) {E.components = cs'}}-    let f' n =-          F.all (\cId -> A.member cId $ nodeArchetype n) (filterWith dynF)-            && F.all (\cId -> not (A.member cId $ nodeArchetype n)) (filterWithout dynF)-    unAccessT $ filterMapDyn (Q.reads rws <> Q.writes rws) f' dynQ+-- | Lookup a component by `EntityID`.+--+-- @since 0.11+lookup :: (Monad m, Component a) => EntityID -> AccessT m (Maybe a)+lookup e = AccessT $ do+  !w <- get+  return $ W.lookup e w --- | @since 0.9-instance (Monad m) => MonadDynamicReaderSystem DynamicQueryReader (AccessT m) where-  allDyn cIds q = AccessT $ do-    !w <- get-    return . Q.allDyn cIds q $ entities w-  filterDyn cIds q f = AccessT $ do-    !w <- get-    return . Q.filterDyn cIds f q $ entities w+-- | Remove a component by `EntityID`.+--+-- @since 0.11+remove :: (Monad m, Component a) => EntityID -> AccessT m (Maybe a)+remove e = AccessT $ do+  !w <- get+  let !(a, w') = W.remove e w+  put w'+  return a --- | @since 0.9-instance (Monad m) => MonadDynamicSystem (DynamicQueryT m) (AccessT m) where-  mapDyn cIds q = AccessT $ do-    !w <- get-    (as, es) <- lift . Q.mapDyn cIds q $ entities w-    put w {entities = es}-    return as-  mapSingleMaybeDyn cIds q = AccessT $ do-    !w <- get-    (res, es) <- lift . Q.mapSingleMaybeDyn cIds q $ entities w-    put w {entities = es}-    return res-  filterMapDyn cIds f q = AccessT $ do-    !w <- get-    (as, es) <- lift . Q.filterMapDyn cIds f q $ entities w-    put w {entities = es}-    return as+-- | Despawn an entity by `EntityID`.+--+-- @since 0.11+despawn :: (Monad m) => EntityID -> AccessT m ()+despawn e = AccessT $ do+  !w <- get+  let !(_, w') = W.despawn e w+  put w'  -- | Run a `System`. ----- @since 0.9-system :: System a -> AccessT IO a+-- @since 0.11+system :: (Monad m) => SystemT m a -> AccessT m a system s = AccessT $ do   !w <- get+  let go f = do+        es <- get+        let es' = f es+        put es'+        return es'+  (a, es) <- lift $ runStateT (runSystemT s go) (entities w)+  put w {entities = es}+  return a++-- | Run a `System` concurrently.+--+-- @since 0.11+concurrently :: SystemT IO a -> AccessT IO a+concurrently s = AccessT $ do+  !w <- get   esVar <- lift . newTVarIO $ entities w-  a <- lift . atomically $ runReaderT (runSystemT s) esVar+  let go f = atomically $ do+        es <- readTVar esVar+        let es' = f es+        writeTVar esVar es'+        return es'+  a <- liftIO $ S.concurrently s go   es <- lift $ readTVarIO esVar   put w {entities = es}   return a
− src/Aztecs/ECS/Access/Class.hs 
@@ -1,52 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}---- |--- Module      : Aztecs.ECS.Access.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Access.Class (MonadAccess (..)) where--import Aztecs.ECS.Component-import Aztecs.ECS.Entity-import Aztecs.ECS.World.Bundle.Class---- | Monadic access to a `World`.------ @since 0.9-class (MonoidBundle b, Monad m) => MonadAccess b m | m -> b where-  -- | Spawn an entity with a component.-  ---  -- @since 0.9-  spawn :: b -> m EntityID--  -- | Spawn an entity with a component.-  ---  -- @since 0.9-  spawn_ :: b -> m ()-  spawn_ c = do-    _ <- spawn c-    return ()--  -- | Insert a component into an entity.-  ---  -- @since 0.9-  insert :: EntityID -> b -> m ()--  -- | Lookup a component on an entity.-  ---  -- @since 0.9-  lookup :: (Component a) => EntityID -> m (Maybe a)--  -- | Remove a component from an entity.-  ---  -- @since 0.9-  remove :: (Component a) => EntityID -> m (Maybe a)--  -- | Despawn an entity.-  ---  -- @since 0.9-  despawn :: EntityID -> m ()
src/Aztecs/ECS/Query.hs view
@@ -17,300 +17,260 @@ -- Maintainer  : matt@hunzinger.me -- Stability   : provisional -- Portability : non-portable (GHC extensions)------ Query for matching entities.------ === Do notation:--- > move :: (ArrowQuery arr) => arr () Position--- > move = proc () -> do--- >   Velocity v <- Q.fetch -< ()--- >   Position p <- Q.fetch -< ()--- >   Q.set -< Position $ p + v------ === Arrow combinators:--- > move :: (ArrowQuery arr) => arr () Position--- > move = Q.fetch &&& Q.fetch >>> arr (\(Position p, Velocity v) -> Position $ p + v) >>> Q.set------ === Applicative combinators:--- > move :: (ArrowQuery arr) => arr () Position--- > move = (,) <$> Q.fetch <*> Q.fetch >>> arr (\(Position p, Velocity v) -> Position $ p + v) >>> Q.set module Aztecs.ECS.Query   ( -- * Queries     Query,     QueryT (..),-    QueryReaderF (..),-    QueryF (..),-    DynamicQueryReaderF (..),-    DynamicQueryF (..), -    -- ** Running-    all,-    all',-    single,-    single',-    singleMaybe,-    singleMaybe',-    map,-    mapSingle,-    mapSingleMaybe,--    -- ** Conversion-    fromReader,-    toReader,-    fromDyn,+    -- ** Operations+    entity,+    fetch,+    fetchMap,+    fetchMapM,+    zipFetchMap,+    zipFetchMapAccum,+    zipFetchMapM,+    zipFetchMapAccumM, -    -- * Filters-    QueryFilter (..),+    -- ** Filters     with,     without, -    -- * Reads and writes-    ReadsWrites (..),-    disjoint,+    -- ** Running+    query,+    readSingle,+    readSingle',+    readSingleMaybe,+    readSingleMaybe',+    querySingle,+    querySingleMaybe,+    queryEntities,+    readQueryEntities,++    -- ** Conversion+    fromDyn,   ) where  import Aztecs.ECS.Component-import Aztecs.ECS.Query.Class+import Aztecs.ECS.Entity import Aztecs.ECS.Query.Dynamic-import Aztecs.ECS.Query.Reader (QueryFilter (..), QueryReader (..), with, without)-import qualified Aztecs.ECS.Query.Reader as QR-import Aztecs.ECS.Query.Reader.Class import Aztecs.ECS.World.Components (Components) import qualified Aztecs.ECS.World.Components as CS import Aztecs.ECS.World.Entities (Entities (..))-import Control.Category import Control.Monad.Identity-import Control.Monad.Writer-import Data.Set (Set)-import qualified Data.Set as Set import GHC.Stack-import Prelude hiding (all, id, map, reads, (.)) --- | @since 0.10+-- | @since 0.11 type Query = QueryT Identity  -- | Query for matching entities. ----- @since 0.10+-- @since 0.11 newtype QueryT f a = Query   { -- | Run a query, producing a `DynamicQueryT`.     ---    -- @since 0.10-    runQuery :: Components -> (ReadsWrites, Components, DynamicQueryT f a)+    -- @since 0.11+    runQuery :: Components -> (Components, DynamicQueryT f a)   }   deriving (Functor) --- | @since 0.10+-- | @since 0.11 instance (Applicative f) => Applicative (QueryT f) where   {-# INLINE pure #-}-  pure a = Query (mempty,,pure a)+  pure a = Query (,pure a)    {-# INLINE (<*>) #-}   (Query f) <*> (Query g) = Query $ \cs ->-    let !(cIdsG, cs', aQS) = g cs-        !(cIdsF, cs'', bQS) = f cs'-     in (cIdsG <> cIdsF, cs'', bQS <*> aQS)---- | @since 0.10-instance (Applicative f) => QueryReaderF (QueryT f) where-  {-# INLINE fetch #-}-  fetch = fromReader fetch--  {-# INLINE fetchMaybe #-}-  fetchMaybe = fromReader fetchMaybe---- | @since 0.10-instance (Applicative f) => DynamicQueryReaderF (QueryT f) where-  {-# INLINE entity #-}-  entity = fromReader entity--  {-# INLINE fetchDyn #-}-  fetchDyn = fromReader . fetchDyn--  {-# INLINE fetchMaybeDyn #-}-  fetchMaybeDyn = fromReader . fetchMaybeDyn+    let !(cs', aQS) = g cs+        !(cs'', bQS) = f cs'+     in (cs'', bQS <*> aQS) --- | @since 0.10-instance (Applicative f) => DynamicQueryF f (QueryT f) where-  {-# INLINE adjustDyn #-}-  adjustDyn f = fromDynInternal $ adjustDyn f+-- | Fetch the current `EntityID`.+--+-- @since 0.11+{-# INLINE entity #-}+entity :: QueryT f EntityID+entity = Query (,entityDyn) -  {-# INLINE adjustDyn_ #-}-  adjustDyn_ f = fromDynInternal $ adjustDyn_ f+-- | Fetch a component.+--+-- @since 0.11+{-# INLINE fetch #-}+fetch :: forall f a. (Component a) => QueryT f a+fetch = fromDynInternal @f @a $ fetchDyn -  {-# INLINE adjustDynM #-}-  adjustDynM f = fromDynInternal $ adjustDynM f+-- | Fetch a component and map it, storing the result.+--+-- @since 0.11+{-# INLINE fetchMap #-}+fetchMap :: forall m a. (Component a) => (a -> a) -> QueryT m a+fetchMap f = fromDynInternal @_ @a $ fetchMapDyn f -  {-# INLINE setDyn #-}-  setDyn = fromDynInternal setDyn+-- | Fetch a component and map it with a monadic function, storing the result.+--+-- @since 0.11+{-# INLINE fetchMapM #-}+fetchMapM :: forall m a. (Monad m, Component a) => (a -> m a) -> QueryT m a+fetchMapM f = fromDynInternal @_ @a $ fetchMapDynM f --- | @since 0.9-instance (Monad m) => QueryF m (QueryT m) where-  {-# INLINE adjust #-}-  adjust :: forall a b. (Component a) => (b -> a -> a) -> QueryT m b -> QueryT m a-  adjust f = fromWriterInternal @a $ adjustDyn f+-- | Fetch a component and map it with some input, storing the result.+--+-- @since 0.11+{-# INLINE zipFetchMap #-}+zipFetchMap :: forall m a b. (Component a) => (b -> a -> a) -> QueryT m b -> QueryT m a+zipFetchMap f = fromWriterInternal @a $ zipFetchMapDyn f -  {-# INLINE adjust_ #-}-  adjust_ :: forall a b. (Component a) => (b -> a -> a) -> QueryT m b -> QueryT m ()-  adjust_ f = fromWriterInternal @a $ adjustDyn_ f+-- | Fetch a component and map it with some input, storing the result and returning some output.+--+-- @since 0.11+{-# INLINE zipFetchMapAccum #-}+zipFetchMapAccum ::+  forall m a b c. (Component a) => (b -> a -> (c, a)) -> QueryT m b -> QueryT m (c, a)+zipFetchMapAccum f = fromWriterInternal @a $ zipFetchMapAccumDyn f -  {-# INLINE adjustM #-}-  adjustM :: forall a b. (Component a, Monad m) => (b -> a -> m a) -> QueryT m b -> QueryT m a-  adjustM f = fromWriterInternal @a $ adjustDynM f+-- | Fetch a component and map it with some input and a monadic function, storing the result.+--+-- @since 0.11+{-# INLINE zipFetchMapM #-}+zipFetchMapM :: forall m a b. (Monad m, Component a) => (b -> a -> m a) -> QueryT m b -> QueryT m a+zipFetchMapM f = fromWriterInternal @a $ zipFetchMapDynM f -  {-# INLINE set #-}-  set :: forall a. (Component a) => QueryT m a -> QueryT m a-  set = fromWriterInternal @a setDyn+-- | Fetch a component and map it with some input and a monadic function,+-- storing the result and returning some output.+--+-- @since 0.11+{-# INLINE zipFetchMapAccumM #-}+zipFetchMapAccumM ::+  forall m a b c. (Monad m, Component a) => (b -> a -> m (c, a)) -> QueryT m b -> QueryT m (c, a)+zipFetchMapAccumM f = fromWriterInternal @a $ zipFetchMapAccumDynM f --- | Convert a `QueryReader` to a `Query`.+-- | Filter for entities with a component. ----- @since 0.9-{-# INLINE fromReader #-}-fromReader :: (Applicative f) => QueryReader a -> QueryT f a-fromReader (QueryReader f) = Query $ \cs ->-  let !(cIds, cs', dynQ) = f cs in (ReadsWrites cIds Set.empty, cs', fromDynReader dynQ)+-- @since 0.11+{-# INLINE with #-}+with :: forall f a. (Component a) => QueryT f ()+with = fromDynInternal @f @a $ withDyn --- | Convert a `Query` to a `QueryReader`.+-- | Filter for entities without a component. ----- @since 0.10-{-# INLINE toReader #-}-toReader :: Query a -> QueryReader a-toReader (Query f) = QueryReader $ \cs ->-  let !(rws, cs', dynQ) = f cs in (reads rws, cs', toDynReader dynQ)+-- @since 0.11+{-# INLINE without #-}+without :: forall f a. (Component a) => QueryT f ()+without = fromDynInternal @f @a $ withDyn  -- | Convert a `DynamicQueryT` to a `QueryT`. ----- @since 0.10+-- @since 0.11 {-# INLINE fromDyn #-}-fromDyn :: ReadsWrites -> DynamicQueryT f a -> QueryT f a-fromDyn rws q = Query (rws,,q)+fromDyn :: DynamicQueryT f a -> QueryT f a+fromDyn q = Query (,q)  {-# INLINE fromDynInternal #-} fromDynInternal ::-  (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a) ->-  ComponentID ->-  QueryT f b ->-  QueryT f a-fromDynInternal f cId q = Query $ \cs ->-  let !(rws, cs', dynQ) = runQuery q cs-   in (rws <> ReadsWrites Set.empty (Set.singleton cId), cs', f cId dynQ)+  forall f a b.+  (Component a) =>+  (ComponentID -> DynamicQueryT f b) ->+  QueryT f b+fromDynInternal f = Query $ \cs ->+  let !(cId, cs') = CS.insert @a cs in (cs', f cId)  {-# INLINE fromWriterInternal #-} fromWriterInternal ::   forall c f a b.-  (Applicative f, Component c) =>+  (Component c) =>   (ComponentID -> DynamicQueryT f b -> DynamicQueryT f a) ->   QueryT f b ->   QueryT f a fromWriterInternal f q = Query $ \cs ->   let !(cId, cs') = CS.insert @c cs-      !(rws, cs'', dynQ) = runQuery q cs'-   in (rws <> ReadsWrites Set.empty (Set.singleton cId), cs'', f cId dynQ)+      !(cs'', dynQ) = runQuery q cs'+   in (cs'', f cId dynQ) --- | Reads and writes of a `Query`.+-- | Match and update all entities. ----- @since 0.9-data ReadsWrites = ReadsWrites-  { -- | Component IDs being read.-    ---    -- @since 0.9-    reads :: !(Set ComponentID),-    -- | Component IDs being written.-    ---    -- @since 0.9-    writes :: !(Set ComponentID)-  }-  deriving (Show)---- | @since 0.9-instance Semigroup ReadsWrites where-  ReadsWrites r1 w1 <> ReadsWrites r2 w2 = ReadsWrites (r1 <> r2) (w1 <> w2)---- | @since 0.9-instance Monoid ReadsWrites where-  mempty = ReadsWrites mempty mempty+-- @since 0.11+{-# INLINE query #-}+query :: (Monad m) => QueryT m a -> Entities -> m ([a], Entities)+query q es = do+  let !(cs', dynQ) = runQuery q $ components es+  (as, es') <- queryDyn dynQ es+  return (as, es' {components = cs'}) --- | `True` if the reads and writes of two `Query`s overlap.+-- | Match and update a single matched entity. ----- @since 0.9-disjoint :: ReadsWrites -> ReadsWrites -> Bool-disjoint a b =-  Set.disjoint (reads a) (writes b)-    || Set.disjoint (reads b) (writes a)-    || Set.disjoint (writes b) (writes a)+-- @since 0.11+{-# INLINE querySingle #-}+querySingle :: (HasCallStack, Monad m) => QueryT m a -> Entities -> m (a, Entities)+querySingle q es = do+  let !(cs', dynQ) = runQuery q $ components es+  (as, es') <- mapSingleDyn dynQ es+  return (as, es' {components = cs'}) --- | Match all entities.+-- | Match and update a single matched entity, or `Nothing`. ----- @since 0.10-{-# INLINE all #-}-all :: Query a -> Entities -> ([a], Entities)-all = QR.all . toReader+-- @since 0.11+{-# INLINE querySingleMaybe #-}+querySingleMaybe :: (Monad m) => QueryT m a -> Entities -> m (Maybe a, Entities)+querySingleMaybe q es = do+  let !(cs', dynQ) = runQuery q $ components es+  (as, es') <- mapSingleMaybeDyn dynQ es+  return (as, es' {components = cs'}) --- | Match all entities.+-- | Match and update the specified entities. ----- @since 0.10-{-# INLINE all' #-}-all' :: Query a -> Entities -> ([a], Components)-all' = QR.all' . toReader+-- @since 0.11+queryEntities :: (Monad m) => [EntityID] -> QueryT m a -> Entities -> m ([a], Entities)+queryEntities eIds q es = do+  let !(cs', dynQ) = runQuery q $ components es+  (as, es') <- queryEntitiesDyn eIds dynQ es+  return (as, es' {components = cs'})  -- | Match a single entity. ----- @since 0.10-{-# INLINE single #-}-single :: (HasCallStack) => Query a -> Entities -> (a, Entities)-single = QR.single . toReader+-- @since 0.11+{-# INLINE readSingle #-}+readSingle :: (HasCallStack, Monad m) => QueryT m a -> Entities -> m (a, Entities)+readSingle q es = do+  let !(cs', dynQ) = runQuery q $ components es+  as <- singleDyn dynQ es+  return (as, es {components = cs'})  -- | Match a single entity. ----- @since 0.10-{-# INLINE single' #-}-single' :: (HasCallStack) => Query a -> Entities -> (a, Components)-single' = QR.single' . toReader+-- @since 0.11+{-# INLINE readSingle' #-}+readSingle' :: (HasCallStack, Monad m) => QueryT m a -> Entities -> m (a, Components)+readSingle' q es = do+  let !(cs', dynQ) = runQuery q $ components es+  as <- singleDyn dynQ es+  return (as, cs')  -- | Match a single entity, or `Nothing`. ----- @since 0.10-{-# INLINE singleMaybe #-}-singleMaybe :: Query a -> Entities -> (Maybe a, Entities)-singleMaybe = QR.singleMaybe . toReader+-- @since 0.11+{-# INLINE readSingleMaybe #-}+readSingleMaybe :: (Monad m) => QueryT m a -> Entities -> m (Maybe a, Entities)+readSingleMaybe q es = do+  let !(cs', dynQ) = runQuery q $ components es+  as <- singleMaybeDyn dynQ es+  return (as, es {components = cs'})  -- | Match a single entity, or `Nothing`. ----- @since 0.10-{-# INLINE singleMaybe' #-}-singleMaybe' :: Query a -> Entities -> (Maybe a, Components)-singleMaybe' = QR.singleMaybe' . toReader---- | Map all matched entities.------ @since 0.10-{-# INLINE map #-}-map :: (Monad m) => QueryT m o -> Entities -> m ([o], Entities)-map q es = do-  let !(rws, cs', dynQ) = runQuery q $ components es-      !cIds = reads rws <> writes rws-  (as, es') <- mapDyn cIds dynQ es-  return (as, es' {components = cs'})---- | Map a single matched entity.------ @since 0.10-{-# INLINE mapSingle #-}-mapSingle :: (HasCallStack, Monad m) => QueryT m a -> Entities -> m (a, Entities)-mapSingle q es = do-  let !(rws, cs', dynQ) = runQuery q $ components es-      !cIds = reads rws <> writes rws-  (as, es') <- mapSingleDyn cIds dynQ es-  return (as, es' {components = cs'})+-- @since 0.11+{-# INLINE readSingleMaybe' #-}+readSingleMaybe' :: (Monad m) => QueryT m a -> Entities -> m (Maybe a, Components)+readSingleMaybe' q es = do+  let !(cs', dynQ) = runQuery q $ components es+  as <- singleMaybeDyn dynQ es+  return (as, cs') --- | Map a single matched entity, or `Nothing`.+-- | Match the specified entities. ----- @since 0.10-{-# INLINE mapSingleMaybe #-}-mapSingleMaybe :: (Monad m) => QueryT m a -> Entities -> m (Maybe a, Entities)-mapSingleMaybe q es = do-  let !(rws, cs', dynQ) = runQuery q $ components es-      !cIds = reads rws <> writes rws-  (as, es') <- mapSingleMaybeDyn cIds dynQ es-  return (as, es' {components = cs'})+-- @since 0.11+readQueryEntities :: (Monad m) => [EntityID] -> QueryT m a -> Entities -> m ([a], Entities)+readQueryEntities eIds q es = do+  let !(cs', dynQ) = runQuery q $ components es+  as <- readQueryEntitiesDyn eIds dynQ es+  return (as, es {components = cs'})
− src/Aztecs/ECS/Query/Class.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE ScopedTypeVariables #-}---- |--- Module      : Aztecs.ECS.Query.Reader.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Class (QueryF (..)) where--import Aztecs.ECS.Component-import Control.Monad---- | Query functor.------ @since 0.10-class (Applicative g, Functor f) => QueryF g f | f -> g where-  -- | Adjust a `Component` by its type.-  ---  -- @since 0.10-  adjust :: (Component a) => (b -> a -> a) -> f b -> f a--  -- | Adjust a `Component` by its type, ignoring any output.-  ---  -- @since 0.10-  adjust_ :: (Component a) => (b -> a -> a) -> f b -> f ()-  adjust_ f = void . adjust f--  -- | Adjust a `Component` by its type with some `Monad` @m@.-  ---  -- @since 0.10-  adjustM :: (Component a) => (b -> a -> g a) -> f b -> f a--  -- | Set a `Component` by its type.-  ---  -- @since 0.10-  set :: (Component a) => f a -> f a
src/Aztecs/ECS/Query/Dynamic.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}  -- |@@ -17,143 +18,435 @@   ( -- * Dynamic queries     DynamicQuery,     DynamicQueryT (..),-    DynamicQueryReaderF (..),-    DynamicQueryF (..), -    -- ** Conversion-    fromDynReader,-    toDynReader,+    -- ** Operations+    entityDyn,+    fetchDyn,+    fetchMaybeDyn,+    fetchMapDyn,+    fetchMapDynM,+    zipFetchMapDyn,+    zipFetchMapAccumDyn,+    zipFetchMapDynM,+    zipFetchMapAccumDynM, +    -- ** Filters+    withDyn,+    withoutDyn,+     -- ** Running-    mapDyn,-    filterMapDyn,+    queryDyn,+    singleDyn,+    singleMaybeDyn,+    queryEntitiesDyn,+    readQueryDyn,     mapSingleDyn,     mapSingleMaybeDyn,+    readQueryEntitiesDyn, -    -- * Dynamic query filters-    DynamicQueryFilter (..),+    -- *** Internal+    QueryFilter (..),+    queryFilter,+    runDynQuery,+    runDynQueryEntities,+    readDynQuery,+    readDynQueryEntities,   ) where  import Aztecs.ECS.Component-import Aztecs.ECS.Query.Dynamic.Class-import Aztecs.ECS.Query.Dynamic.Reader+import Aztecs.ECS.Entity import Aztecs.ECS.World.Archetype (Archetype) import qualified Aztecs.ECS.World.Archetype as A import Aztecs.ECS.World.Archetypes (ArchetypeID, Node (..)) import qualified Aztecs.ECS.World.Archetypes as AS-import Aztecs.ECS.World.Entities (Entities (..))+import Aztecs.ECS.World.Entities+import Control.Applicative import Control.Monad.Identity+import Data.Bifunctor import Data.Foldable import Data.Map (Map)-import qualified Data.Map as Map+import qualified Data.Map.Strict as Map+import Data.Maybe import Data.Set (Set) import qualified Data.Set as Set import GHC.Stack+import Prelude hiding (reads) +data Operation f a where+  Entity :: Operation f EntityID+  Fetch :: (Component a) => !ComponentID -> Operation f a+  FetchMaybe :: (Component a) => !ComponentID -> Operation f (Maybe a)+  FetchMap :: (Component a) => !(a -> a) -> !ComponentID -> Operation f a+  FetchMapM :: (Monad f, Component a) => !(a -> f a) -> !ComponentID -> Operation f a+  Adjust :: (Component a) => !(b -> a -> (c, a)) -> !ComponentID -> !(DynamicQueryT f b) -> Operation f (c, a)+  AdjustM :: (Monad f, Component a) => !(b -> a -> f (c, a)) -> !ComponentID -> !(DynamicQueryT f b) -> Operation f (c, a)+  With :: !ComponentID -> Operation f ()+  Without :: !ComponentID -> Operation f ()++-- @since 0.9 type DynamicQuery = DynamicQueryT Identity  -- | Dynamic query for components by ID. ----- @since 0.10-newtype DynamicQueryT f a-  = DynamicQuery-  { -- | Run a dynamic query.-    ---    -- @since 0.10-    runDynQuery :: Archetype -> f ([a], Archetype)-  }-  deriving (Functor)+-- @since 0.11+data DynamicQueryT f a where+  Pure :: !a -> DynamicQueryT f a+  Map :: !(a -> b) -> !(DynamicQueryT f a) -> DynamicQueryT f b+  Ap :: !(DynamicQueryT f (a -> b)) -> !(DynamicQueryT f a) -> DynamicQueryT f b+  Op :: !(Operation f a) -> DynamicQueryT f a --- | @since 0.10-instance (Applicative f) => Applicative (DynamicQueryT f) where+instance Functor (DynamicQueryT f) where+  {-# INLINE fmap #-}+  fmap = Map++-- | @since 0.11+instance Applicative (DynamicQueryT f) where   {-# INLINE pure #-}-  pure a = DynamicQuery $ \arch -> pure (replicate (length $ A.entities arch) a, arch)+  pure = Pure    {-# INLINE (<*>) #-}-  f <*> g = DynamicQuery $ \arch -> do-    x <- runDynQuery g arch-    y <- runDynQuery f arch-    return $-      let (as, arch') = x-          (bs, arch'') = y-       in (zipWith ($) bs as, arch' <> arch'')+  (<*>) = Ap --- | @since 0.10-instance DynamicQueryReaderF DynamicQuery where-  {-# INLINE entity #-}-  entity = fromDynReader entity+{-# INLINE entityDyn #-}+entityDyn :: DynamicQueryT f EntityID+entityDyn = Op Entity -  {-# INLINE fetchDyn #-}-  fetchDyn = fromDynReader . fetchDyn+{-# INLINE fetchDyn #-}+fetchDyn :: (Component a) => ComponentID -> DynamicQueryT f a+fetchDyn = Op . Fetch -  {-# INLINE fetchMaybeDyn #-}-  fetchMaybeDyn = fromDynReader . fetchMaybeDyn+{-# INLINE fetchMaybeDyn #-}+fetchMaybeDyn :: (Component a) => ComponentID -> DynamicQueryT f (Maybe a)+fetchMaybeDyn = Op . FetchMaybe --- | @since 0.10-instance (Applicative f) => DynamicQueryF f (DynamicQueryT f) where-  {-# INLINE adjustDyn #-}-  adjustDyn f cId q =-    DynamicQuery (fmap (\(bs, arch') -> A.zipWith bs f cId arch') . runDynQuery q)+{-# INLINE fetchMapDyn #-}+fetchMapDyn :: (Component a) => (a -> a) -> ComponentID -> DynamicQueryT f a+fetchMapDyn f = Op . FetchMap f -  {-# INLINE adjustDyn_ #-}-  adjustDyn_ f cId q = DynamicQuery $ \arch ->-    fmap (\(bs, arch') -> (map (const ()) bs, A.zipWith_ bs f cId arch')) (runDynQuery q arch)+{-# INLINE fetchMapDynM #-}+fetchMapDynM :: (Monad f, Component a) => (a -> f a) -> ComponentID -> DynamicQueryT f a+fetchMapDynM f = Op . FetchMapM f -  {-# INLINE adjustDynM #-}-  adjustDynM f cId q = DynamicQuery $ \arch -> do-    (bs, arch') <- runDynQuery q arch-    A.zipWithM bs f cId arch'+{-# INLINE zipFetchMapDyn #-}+zipFetchMapDyn :: (Component a) => (b -> a -> a) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a+zipFetchMapDyn f cId q = snd <$> Op (Adjust (\b a -> ((), f b a)) cId q) -  {-# INLINE setDyn #-}-  setDyn cId q =-    DynamicQuery (fmap (\(bs, arch') -> (bs, A.insertAscList cId bs arch')) . runDynQuery q)+{-# INLINE zipFetchMapAccumDyn #-}+zipFetchMapAccumDyn :: (Component a) => (b -> a -> (c, a)) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f (c, a)+zipFetchMapAccumDyn f cId q = Op $ Adjust f cId q --- | Convert a `DynamicQueryReaderT` to a `DynamicQueryT`.------ @since 0.10-{-# INLINE fromDynReader #-}-fromDynReader :: (Applicative m) => DynamicQueryReader a -> DynamicQueryT m a-fromDynReader q = DynamicQuery $ \arch -> let !os = runDynQueryReader q arch in pure (os, arch)+{-# INLINE zipFetchMapDynM #-}+zipFetchMapDynM :: (Monad f, Component a) => (b -> a -> f a) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f a+zipFetchMapDynM f cId q = snd <$> zipFetchMapAccumDynM (\b a -> ((),) <$> f b a) cId q --- | Convert a `DynamicQueryT` to a `DynamicQueryReaderT`.------ @since 0.10-{-# INLINE toDynReader #-}-toDynReader :: DynamicQuery a -> DynamicQueryReader a-toDynReader q = DynamicQueryReader $ \arch -> fst $ runIdentity $ runDynQuery q arch+{-# INLINE zipFetchMapAccumDynM #-}+zipFetchMapAccumDynM :: (Monad f, Component a) => (b -> a -> f (c, a)) -> ComponentID -> DynamicQueryT f b -> DynamicQueryT f (c, a)+zipFetchMapAccumDynM f cId q = Op $ AdjustM f cId q --- | Map all matched entities.------ @since 0.10-{-# INLINE mapDyn #-}-mapDyn :: (Monad m) => Set ComponentID -> DynamicQueryT m a -> Entities -> m ([a], Entities)-mapDyn cIds = mapDyn' cIds id+{-# INLINE withDyn #-}+withDyn :: ComponentID -> DynamicQueryT f ()+withDyn = Op . With --- | Map all matched entities with a filter.------ @since 0.10-{-# INLINE filterMapDyn #-}-filterMapDyn ::+{-# INLINE withoutDyn #-}+withoutDyn :: ComponentID -> DynamicQueryT f ()+withoutDyn = Op . Without++{-# INLINE opFilter #-}+opFilter :: Operation f a -> QueryFilter+opFilter Entity = mempty+opFilter (Fetch cId) = mempty {filterWith = Set.singleton cId}+opFilter (FetchMaybe cId) = mempty {filterWith = Set.singleton cId}+opFilter (FetchMap _ cId) = mempty {filterWith = Set.singleton cId}+opFilter (FetchMapM _ cId) = mempty {filterWith = Set.singleton cId}+opFilter (Adjust _ cId q) = queryFilter q <> mempty {filterWith = Set.singleton cId}+opFilter (AdjustM _ cId q) = queryFilter q <> mempty {filterWith = Set.singleton cId}+opFilter (With cId) = mempty {filterWith = Set.singleton cId}+opFilter (Without cId) = mempty {filterWithout = Set.singleton cId}++{-# INLINE queryFilter #-}+queryFilter :: DynamicQueryT f a -> QueryFilter+queryFilter (Pure _) = mempty+queryFilter (Map _ q) = queryFilter q+queryFilter (Ap f g) = queryFilter f <> queryFilter g+queryFilter (Op op) = opFilter op++{-# INLINE runOp #-}+runOp :: (Applicative f) => Operation f a -> Archetype -> f ([a], Archetype)+runOp Entity arch = pure (Set.toList $ A.entities arch, mempty)+runOp (Fetch cId) arch = pure (A.lookupComponentsAsc cId arch, mempty)+runOp (FetchMaybe cId) arch =+  pure+    ( case A.lookupComponentsAscMaybe cId arch of+        Just as -> fmap Just as+        Nothing -> replicate (length $ A.entities arch) Nothing,+      mempty+    )+runOp (FetchMap f cId) arch = pure $ A.map f cId arch+runOp (FetchMapM f cId) arch = do+  (as, arch') <- A.mapM f cId arch+  return (as, arch')+runOp (Adjust f cId q) arch = do+  res <- runDynQuery q arch+  return $+    let !(bs, arch') = res+        !(as, arch'') = A.zipWith bs f cId arch+     in (as, arch'' <> arch')+runOp (AdjustM f cId q) arch = do+  (as, arch') <- runDynQuery q arch+  (bs, arch'') <- A.zipWithM as f cId arch+  return (bs, arch'' <> arch')+runOp (With _) _ = pure ([], mempty)+runOp (Without _) _ = pure ([], mempty)++{-# INLINE readOp #-}+readOp :: (Applicative f) => Operation f a -> Archetype -> f [a]+readOp Entity arch = pure $ Set.toList $ A.entities arch+readOp (Fetch cId) arch = pure $ A.lookupComponentsAsc cId arch+readOp (FetchMaybe cId) arch =+  pure $+    case A.lookupComponentsAscMaybe cId arch of+      Just as -> fmap Just as+      Nothing -> replicate (length $ A.entities arch) Nothing+readOp (FetchMap f cId) arch = do+  bs <- readOp (Fetch cId) arch+  return $ map f bs+readOp (FetchMapM f cId) arch = do+  bs <- readOp (Fetch cId) arch+  mapM f bs+readOp (Adjust f cId q) arch = do+  as <- readDynQuery q arch+  bs <- readOp (Fetch cId) arch+  return $ zipWith f as bs+readOp (AdjustM f cId q) arch = do+  as <- readDynQuery q arch+  bs <- readOp (Fetch cId) arch+  zipWithM f as bs+readOp (With _) _ = pure []+readOp (Without _) _ = pure []++{-# INLINE queryEntitiesDyn #-}+queryEntitiesDyn ::   (Monad m) =>-  Set ComponentID ->-  (Node -> Bool) ->+  [EntityID] ->   DynamicQueryT m a ->   Entities ->   m ([a], Entities)-filterMapDyn cIds f = mapDyn' cIds (Map.filter f)+queryEntitiesDyn eIds q es =+  let qf = queryFilter q+      go = runDynQueryEntities eIds q+   in if Set.null $ filterWith qf+        then do+          (as, _) <- go A.empty {A.entities = Map.keysSet $ entities es}+          return (as, es)+        else+          let go' (acc, esAcc) (aId, n) = do+                (as', arch') <- go $ nodeArchetype n+                let n' = n {nodeArchetype = arch' <> nodeArchetype n}+                    !nodes = Map.insert aId n' . AS.nodes $ archetypes esAcc+                return (as' ++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}})+           in foldlM go' ([], es) $ Map.toList . AS.find (filterWith qf) (filterWithout qf) $ archetypes es +readQueryEntitiesDyn :: (Monad m) => [EntityID] -> DynamicQueryT m a -> Entities -> m [a]+readQueryEntitiesDyn eIds q es =+  let qf = queryFilter q+   in if Set.null $ filterWith qf+        then readDynQueryEntities eIds q A.empty {A.entities = Map.keysSet $ entities es}+        else+          let go n = readDynQuery q $ AS.nodeArchetype n+           in concat <$> mapM go (AS.find (filterWith qf) (filterWithout qf) $ archetypes es)++runOpEntities :: (Applicative f) => Operation f a -> [EntityID] -> Archetype -> f ([a], Archetype)+runOpEntities Entity es _ = pure (es, mempty)+runOpEntities (Fetch cId) es arch =+  pure+    ( map snd+        . filter (\(e, _) -> e `elem` es)+        . Map.toList+        $ A.lookupComponents cId arch,+      mempty+    )+runOpEntities (FetchMaybe cId) es arch =+  pure+    ( map (\(e, a) -> if e `elem` es then Just a else Nothing)+        . Map.toList+        $ A.lookupComponents cId arch,+      mempty+    )+runOpEntities (FetchMap f cId) es arch =+  pure $+    let go e a =+          if e `elem` es+            then let a' = f a in (Just a', a')+            else (Nothing, a)+        !(as, arch') = A.zipWith es go cId arch+     in (mapMaybe fst as, arch')+runOpEntities (FetchMapM f cId) es arch = do+  (as, arch') <- runOpEntities (AdjustM (\() a -> (,a) <$> f a) cId (pure ())) es arch+  return (map snd as, arch')+runOpEntities (Adjust f cId q) es arch = do+  res <- runDynQuery q arch+  return $+    let go (e, b) a =+          if e `elem` es+            then let (x, y) = f b a in (Just x, y)+            else (Nothing, a)+        !(bs, arch') = res+        !(as, arch'') = A.zipWith (zip es bs) go cId arch+     in (mapMaybe (\(m, b) -> fmap (,b) m) as, arch'' <> arch')+runOpEntities (AdjustM f cId q) es arch = do+  (bs, arch') <- runDynQuery q arch+  let go (e, b) a =+        if e `elem` es+          then do+            (x, y) <- f b a+            return (Just x, y)+          else return (Nothing, a)+  (as, arch'') <- A.zipWithM (zip es bs) go cId arch+  return (mapMaybe (\(m, b) -> fmap (,b) m) as, arch'' <> arch')+runOpEntities (With _) _ arch = pure ([], arch)+runOpEntities (Without _) _ arch = pure ([], arch)++runDynQueryEntities :: (Applicative f) => [EntityID] -> DynamicQueryT f a -> Archetype -> f ([a], Archetype)+runDynQueryEntities es (Pure a) _ = pure (replicate (length es) a, mempty)+runDynQueryEntities es (Map f q) arch = first (fmap f) <$> runDynQueryEntities es q arch+runDynQueryEntities es (Ap f g) arch = do+  res <- runDynQueryEntities es g arch+  res' <- runDynQueryEntities es f arch+  return $+    let (as, arch') = res+        (bs, arch'') = res'+     in (zipWith ($) bs as, arch'' <> arch')+runDynQueryEntities es (Op op) arch = runOpEntities op es arch++{-# INLINE readOpEntities #-}+readOpEntities :: (Applicative f) => Operation f a -> [EntityID] -> Archetype -> f [a]+readOpEntities Entity es _ = pure es+readOpEntities (Fetch cId) es arch =+  pure+    . map snd+    . filter (\(e, _) -> e `elem` es)+    . Map.toList+    $ A.lookupComponents cId arch+readOpEntities (FetchMaybe cId) es arch =+  pure+    . map (\(e, a) -> if e `elem` es then Just a else Nothing)+    . Map.toList+    $ A.lookupComponents cId arch+readOpEntities (FetchMap f cId) es arch = do+  b <- readOpEntities (Fetch cId) es arch+  pure $ map f b+readOpEntities (FetchMapM f cId) es arch = do+  b <- readOpEntities (Fetch cId) es arch+  mapM f b+readOpEntities (Adjust f cId q) es arch = do+  a <- readDynQueryEntities es q arch+  b <- readOpEntities (Fetch cId) es arch+  pure $ zipWith f a b+readOpEntities (AdjustM f cId q) es arch = do+  a <- readDynQueryEntities es q arch+  b <- readOpEntities (Fetch cId) es arch+  zipWithM f a b+readOpEntities (With _) _ _ = pure []+readOpEntities (Without _) _ _ = pure []++{-# INLINE readDynQueryEntities #-}+readDynQueryEntities :: (Applicative f) => [EntityID] -> DynamicQueryT f a -> Archetype -> f [a]+readDynQueryEntities es (Pure a) _ = pure $ replicate (length es) a+readDynQueryEntities es (Map f q) arch = fmap f <$> readDynQueryEntities es q arch+readDynQueryEntities es (Ap f g) arch = do+  a <- readDynQueryEntities es g arch+  b <- readDynQueryEntities es f arch+  pure $ b <*> a+readDynQueryEntities es (Op op) arch = readOpEntities op es arch++{-# INLINE runDynQuery #-}+runDynQuery :: (Applicative f) => DynamicQueryT f a -> Archetype -> f ([a], Archetype)+runDynQuery (Pure a) arch = pure (replicate (length $ A.entities arch) a, mempty)+runDynQuery (Map f q) arch = do+  res <- runDynQuery q arch+  return $ first (fmap f) res+runDynQuery (Ap f g) arch = do+  res <- runDynQuery g arch+  res' <- runDynQuery f arch+  return $+    let (as, arch') = res+        (bs, arch'') = res'+     in (zipWith ($) bs as, arch'' <> arch')+runDynQuery (Op op) arch = runOp op arch++{-# INLINE readDynQuery #-}+readDynQuery :: (Applicative f) => DynamicQueryT f a -> Archetype -> f [a]+readDynQuery (Pure a) arch = pure $ replicate (length $ A.entities arch) a+readDynQuery (Map f q) arch = fmap f <$> readDynQuery q arch+readDynQuery (Ap f g) arch = do+  as <- readDynQuery g arch+  bs <- readDynQuery f arch+  pure $ zipWith ($) bs as+readDynQuery (Op op) arch = readOp op arch++-- | Match all entities.+--+-- @since 0.11+readQueryDyn :: (Monad m) => DynamicQueryT m a -> Entities -> m [a]+readQueryDyn q es =+  let qf = queryFilter q+   in if Set.null $ filterWith qf+        then readDynQuery q $ A.empty {A.entities = Map.keysSet $ entities es}+        else+          let go n = readDynQuery q $ AS.nodeArchetype n+           in concat <$> mapM go (AS.find (filterWith qf) (filterWithout qf) $ archetypes es)++-- | Match a single entity.+--+-- @since 0.11+singleDyn :: (HasCallStack, Monad m) => DynamicQueryT m a -> Entities -> m a+singleDyn q es = do+  res <- singleMaybeDyn q es+  return $ case res of+    Just a -> a+    _ -> error "singleDyn: expected a single entity"++-- | Match a single entity, or `Nothing`.+--+-- @since 0.11+singleMaybeDyn :: (Monad m) => DynamicQueryT m a -> Entities -> m (Maybe a)+singleMaybeDyn q es =+  let qf = queryFilter q+   in if Set.null $ filterWith qf+        then case Map.keys $ entities es of+          [eId] -> do+            res <- readDynQuery q $ A.singleton eId+            return $ case res of+              [a] -> Just a+              _ -> Nothing+          _ -> return Nothing+        else case Map.elems $ AS.find (filterWith qf) (filterWithout qf) $ archetypes es of+          [n] -> do+            res <- readDynQuery q $ AS.nodeArchetype n+            return $ case res of+              [a] -> Just a+              _ -> Nothing+          _ -> return Nothing++-- | Match and update all matched entities.+--+-- @since 0.11+{-# INLINE queryDyn #-}+queryDyn :: (Monad m) => DynamicQueryT m a -> Entities -> m ([a], Entities)+queryDyn = mapDyn' id+ {-# INLINE mapDyn' #-} mapDyn' ::   (Monad m) =>-  Set ComponentID ->   (Map ArchetypeID Node -> Map ArchetypeID Node) ->   DynamicQueryT m a ->   Entities ->   m ([a], Entities)-mapDyn' cIds f q es =-  let go = runDynQuery q-   in if Set.null cIds+mapDyn' f q es =+  let !qf = queryFilter q+      go = runDynQuery q+   in if Set.null $ filterWith qf         then do           (as, _) <- go A.empty {A.entities = Map.keysSet $ entities es}           return (as, es)@@ -163,38 +456,56 @@                 let n' = n {nodeArchetype = arch' <> nodeArchetype n}                     !nodes = Map.insert aId n' . AS.nodes $ archetypes esAcc                 return (as' ++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}})-           in foldlM go' ([], es) $ Map.toList . f . AS.find cIds $ archetypes es+           in foldlM go' ([], es) $ Map.toList . f . AS.find (filterWith qf) (filterWithout qf) $ archetypes es  -- | Map a single matched entity. ----- @since 0.10-mapSingleDyn :: (HasCallStack, Monad m) => Set ComponentID -> DynamicQueryT m a -> Entities -> m (a, Entities)-mapSingleDyn cIds q es = do-  res <- mapSingleMaybeDyn cIds q es+-- @since 0.11+mapSingleDyn :: (HasCallStack, Monad m) => DynamicQueryT m a -> Entities -> m (a, Entities)+mapSingleDyn q es = do+  (res, es') <- mapSingleMaybeDyn q es   return $ case res of-    (Just a, es') -> (a, es')+    Just a -> (a, es')     _ -> error "mapSingleDyn: expected single matching entity"  -- | Map a single matched entity, or @Nothing@. ----- @since 0.10+-- @since 0.11 {-# INLINE mapSingleMaybeDyn #-}-mapSingleMaybeDyn :: (Monad m) => Set ComponentID -> DynamicQueryT m a -> Entities -> m (Maybe a, Entities)-mapSingleMaybeDyn cIds q es =-  if Set.null cIds-    then case Map.keys $ entities es of-      [eId] -> do-        res <- runDynQuery q $ A.singleton eId-        return $ case res of-          ([a], _) -> (Just a, es)-          _ -> (Nothing, es)-      _ -> pure (Nothing, es)-    else case Map.toList $ AS.find cIds $ archetypes es of-      [(aId, n)] -> do-        res <- runDynQuery q $ AS.nodeArchetype n-        return $ case res of-          ([a], arch') ->-            let nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes es-             in (Just a, es {archetypes = (archetypes es) {AS.nodes = nodes}})-          _ -> (Nothing, es)-      _ -> pure (Nothing, es)+mapSingleMaybeDyn :: (Monad m) => DynamicQueryT m a -> Entities -> m (Maybe a, Entities)+mapSingleMaybeDyn q es =+  let qf = queryFilter q+   in if Set.null $ filterWith qf+        then case Map.keys $ entities es of+          [eId] -> do+            res <- runDynQuery q $ A.singleton eId+            return $ case res of+              ([a], _) -> (Just a, es)+              _ -> (Nothing, es)+          _ -> pure (Nothing, es)+        else case Map.toList $ AS.find (filterWith qf) (filterWithout qf) $ archetypes es of+          [(aId, n)] -> do+            (as, arch') <- runDynQuery q $ AS.nodeArchetype n+            return $ case as of+              [a] ->+                let nodes = Map.insert aId n {nodeArchetype = arch' <> nodeArchetype n} . AS.nodes $ archetypes es+                 in (Just a, es {archetypes = (archetypes es) {AS.nodes = nodes}})+              _ -> (Nothing, es)+          _ -> pure (Nothing, es)++-- | `Query` filter.+--+-- @since 0.11+data QueryFilter = QueryFilter+  { filterWith :: !(Set ComponentID),+    filterWithout :: !(Set ComponentID)+  }+  deriving (Show)++-- | @since 0.9+instance Semigroup QueryFilter where+  QueryFilter r1 w1 <> QueryFilter r2 w2 = QueryFilter (r1 <> r2) (w1 <> w2)++-- | @since 0.9+instance Monoid QueryFilter where+  mempty = QueryFilter mempty mempty
− src/Aztecs/ECS/Query/Dynamic/Class.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}---- |--- Module      : Aztecs.ECS.Query.Dynamic.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Dynamic.Class (DynamicQueryF (..)) where--import Aztecs.ECS.Component-import Control.Monad---- | Dynamic query functor.------ @since 0.10-class (Applicative m, Functor f) => DynamicQueryF m f | f -> m where-  -- | Adjust a `Component` by its `ComponentID`.-  ---  -- @since 0.10-  adjustDyn :: (Component a) => (b -> a -> a) -> ComponentID -> f b -> f a--  -- | Adjust a `Component` by its `ComponentID`, ignoring any output.-  ---  -- @since 0.10-  adjustDyn_ :: (Component a) => (b -> a -> a) -> ComponentID -> f b -> f ()-  adjustDyn_ f cId = void . adjustDyn f cId--  -- | Adjust a `Component` by its `ComponentID` with some applicative functor @g@.-  ---  -- @since 0.10-  adjustDynM :: (Monad m, Component a) => (b -> a -> m a) -> ComponentID -> f b -> f a--  -- | Set a `Component` by its `ComponentID`.-  ---  -- @since 0.10-  setDyn :: (Component a) => ComponentID -> f a -> f a
− src/Aztecs/ECS/Query/Dynamic/Reader.hs 
@@ -1,146 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module      : Aztecs.ECS.Query.Dynamic.Reader--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Dynamic.Reader-  ( -- * Dynamic queries-    DynamicQueryReader (..),-    DynamicQueryReaderF (..),--    -- ** Running-    allDyn,-    filterDyn,-    singleDyn,-    singleMaybeDyn,--    -- * Dynamic query filters-    DynamicQueryFilter (..),-  )-where--import Aztecs.ECS.Component-import Aztecs.ECS.Query.Dynamic.Reader.Class-import Aztecs.ECS.World.Archetype (Archetype)-import qualified Aztecs.ECS.World.Archetype as A-import Aztecs.ECS.World.Archetypes (Node)-import qualified Aztecs.ECS.World.Archetypes as AS-import Aztecs.ECS.World.Entities (Entities (..))-import qualified Data.Map as Map-import Data.Set (Set)-import qualified Data.Set as Set-import GHC.Stack---- | Dynamic query reader.------ @since 0.10-newtype DynamicQueryReader a = DynamicQueryReader-  { -- | Run a dynamic query reader.-    ---    -- @since 0.10-    runDynQueryReader :: Archetype -> [a]-  }-  deriving (Functor)---- | @since 0.10-instance Applicative DynamicQueryReader where-  {-# INLINE pure #-}-  pure a = DynamicQueryReader $ \arch -> replicate (length $ A.entities arch) a--  {-# INLINE (<*>) #-}-  f <*> g = DynamicQueryReader $ \arch ->-    zipWith ($) (runDynQueryReader f arch) $ runDynQueryReader g arch---- | @since 0.10-instance DynamicQueryReaderF DynamicQueryReader where-  {-# INLINE entity #-}-  entity = DynamicQueryReader $ \arch -> Set.toList $ A.entities arch--  {-# INLINE fetchDyn #-}-  fetchDyn cId = DynamicQueryReader $ \arch -> A.lookupComponentsAsc cId arch--  {-# INLINE fetchMaybeDyn #-}-  fetchMaybeDyn cId = DynamicQueryReader $ \arch -> case A.lookupComponentsAscMaybe cId arch of-    Just as -> fmap Just as-    Nothing -> replicate (length $ A.entities arch) Nothing---- | Dynamic query for components by ID.------ @since 0.9---- | Dynamic query filter.------ @since 0.9-data DynamicQueryFilter = DynamicQueryFilter-  { -- | `ComponentID`s to include.-    ---    -- @since 0.9-    filterWith :: !(Set ComponentID),-    -- | `ComponentID`s to exclude.-    ---    -- @since 0.9-    filterWithout :: !(Set ComponentID)-  }---- | @since 0.9-instance Semigroup DynamicQueryFilter where-  DynamicQueryFilter withA withoutA <> DynamicQueryFilter withB withoutB =-    DynamicQueryFilter (withA <> withB) (withoutA <> withoutB)---- | @since 0.9-instance Monoid DynamicQueryFilter where-  mempty = DynamicQueryFilter mempty mempty---- | Match all entities.------ @since 0.10-allDyn :: Set ComponentID -> DynamicQueryReader a -> Entities -> [a]-allDyn cIds q es =-  if Set.null cIds-    then runDynQueryReader q A.empty {A.entities = Map.keysSet $ entities es}-    else-      let go n = runDynQueryReader q $ AS.nodeArchetype n-       in concatMap go (AS.find cIds $ archetypes es)---- | Match all entities with a filter.------ @since 0.10-filterDyn :: Set ComponentID -> (Node -> Bool) -> DynamicQueryReader a -> Entities -> [a]-filterDyn cIds f q es =-  if Set.null cIds-    then runDynQueryReader q A.empty {A.entities = Map.keysSet $ entities es}-    else-      let go n = runDynQueryReader q $ AS.nodeArchetype n-       in concatMap go (Map.filter f $ AS.find cIds $ archetypes es)---- | Match a single entity.------ @since 0.10-singleDyn :: (HasCallStack) => Set ComponentID -> DynamicQueryReader a -> Entities -> a-singleDyn cIds q es = case singleMaybeDyn cIds q es of-  Just a -> a-  _ -> error "singleDyn: expected a single entity"---- | Match a single entity, or `Nothing`.------ @since 0.10-singleMaybeDyn :: Set ComponentID -> DynamicQueryReader a -> Entities -> Maybe a-singleMaybeDyn cIds q es =-  if Set.null cIds-    then case Map.keys $ entities es of-      [eId] -> case runDynQueryReader q $ A.singleton eId of-        [a] -> Just a-        _ -> Nothing-      _ -> Nothing-    else case Map.elems $ AS.find cIds $ archetypes es of-      [n] -> case runDynQueryReader q $ AS.nodeArchetype n of-        [a] -> Just a-        _ -> Nothing-      _ -> Nothing
− src/Aztecs/ECS/Query/Dynamic/Reader/Class.hs 
@@ -1,32 +0,0 @@--- |--- Module      : Aztecs.ECS.Query.Dynamic.Reader.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Dynamic.Reader.Class (DynamicQueryReaderF (..)) where--import Aztecs.ECS.Component-import Aztecs.ECS.Entity---- | Dynamic query reader functor.------ @since 0.10-class (Functor f) => DynamicQueryReaderF f where-  -- | Fetch the currently matched `EntityID`.-  ---  -- @since 0.10-  entity :: f EntityID--  -- | Fetch a `Component` by its `ComponentID`.-  ---  -- @since 0.10-  fetchDyn :: (Component a) => ComponentID -> f a--  -- | Try to fetch a `Component` by its `ComponentID`.-  ---  -- @since 0.10-  fetchMaybeDyn :: (Component a) => ComponentID -> f (Maybe a)-  fetchMaybeDyn cId = Just <$> fetchDyn cId
− src/Aztecs/ECS/Query/Reader.hs 
@@ -1,175 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : Aztecs.ECS.Query.Dynamic--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Reader-  ( -- * Queries-    QueryReader (..),-    QueryReaderF (..),-    DynamicQueryReaderF (..),--    -- ** Running-    all,-    all',-    single,-    single',-    singleMaybe,-    singleMaybe',--    -- * Filters-    QueryFilter (..),-    with,-    without,-    DynamicQueryFilter (..),-  )-where--import Aztecs.ECS.Component-import Aztecs.ECS.Query.Dynamic.Reader-import Aztecs.ECS.Query.Reader.Class-import Aztecs.ECS.World.Components (Components)-import qualified Aztecs.ECS.World.Components as CS-import Aztecs.ECS.World.Entities (Entities (..))-import qualified Aztecs.ECS.World.Entities as E-import Control.Monad.Identity-import Data.Set (Set)-import qualified Data.Set as Set-import GHC.Stack-import Prelude hiding (all)---- | Query to read from entities.------ @since 0.10-newtype QueryReader a-  = QueryReader-  { -- | Run a query reader.-    ---    -- @since 0.10-    runQueryReader :: Components -> (Set ComponentID, Components, DynamicQueryReader a)-  }-  deriving (Functor)---- | @since 0.10-instance Applicative QueryReader where-  pure a = QueryReader (mempty,,pure a)-  {-# INLINE pure #-}--  (QueryReader f) <*> (QueryReader g) = QueryReader $ \cs ->-    let !(cIdsG, cs', aQS) = g cs-        !(cIdsF, cs'', bQS) = f cs'-     in (cIdsG <> cIdsF, cs'', bQS <*> aQS)-  {-# INLINE (<*>) #-}---- | @since 0.10-instance QueryReaderF QueryReader where-  fetch :: forall a. (Component a) => QueryReader a-  fetch = QueryReader $ \cs ->-    let !(cId, cs') = CS.insert @a cs in (Set.singleton cId, cs', fetchDyn cId)-  {-# INLINE fetch #-}--  fetchMaybe :: forall a. (Component a) => QueryReader (Maybe a)-  fetchMaybe = QueryReader $ \cs ->-    let !(cId, cs') = CS.insert @a cs in (Set.singleton cId, cs', fetchMaybeDyn cId)-  {-# INLINE fetchMaybe #-}---- | @since 0.10-instance DynamicQueryReaderF QueryReader where-  {-# INLINE entity #-}-  entity = QueryReader (mempty,,entity)-  {-# INLINE fetchDyn #-}-  fetchDyn cId = QueryReader (Set.singleton cId,,fetchDyn cId)-  {-# INLINE fetchMaybeDyn #-}-  fetchMaybeDyn cId = QueryReader (Set.singleton cId,,fetchMaybeDyn cId)---- | Filter for a `Query`.------ @since 0.9-newtype QueryFilter = QueryFilter-  { -- | Run a query filter.-    runQueryFilter :: Components -> (DynamicQueryFilter, Components)-  }---- | @since 0.9-instance Semigroup QueryFilter where-  a <> b =-    QueryFilter-      ( \cs ->-          let !(withA', cs') = runQueryFilter a cs-              !(withB', cs'') = runQueryFilter b cs'-           in (withA' <> withB', cs'')-      )---- | @since 0.9-instance Monoid QueryFilter where-  mempty = QueryFilter (mempty,)---- | Filter for entities containing this component.------ @since 0.9-with :: forall a. (Component a) => QueryFilter-with = QueryFilter $ \cs ->-  let !(cId, cs') = CS.insert @a cs in (mempty {filterWith = Set.singleton cId}, cs')---- | Filter out entities containing this component.------ @since 0.9-without :: forall a. (Component a) => QueryFilter-without = QueryFilter $ \cs ->-  let !(cId, cs') = CS.insert @a cs in (mempty {filterWithout = Set.singleton cId}, cs')---- | Match all entities.------ @since 0.10-{-# INLINE all #-}-all :: QueryReader a -> Entities -> ([a], Entities)-all q es = let !(as, cs) = all' q es in (as, es {E.components = cs})---- | Match all entities.------ @since 0.10-{-# INLINE all' #-}-all' :: QueryReader a -> Entities -> ([a], Components)-all' q es = let !(rs, cs', dynQ) = runQueryReader q (E.components es) in (allDyn rs dynQ es, cs')---- | Match a single entity.------ @since 0.10-{-# INLINE single #-}-single :: (HasCallStack) => QueryReader a -> Entities -> (a, Entities)-single q es = let !(a, cs) = single' q es in (a, es {E.components = cs})---- | Match a single entity.------ @since 0.10-{-# INLINE single' #-}-single' :: (HasCallStack) => QueryReader a -> Entities -> (a, Components)-single' q es = let !(rs, cs', dynQ) = runQueryReader q (E.components es) in (singleDyn rs dynQ es, cs')---- | Match a single entity.------ @since 0.10-{-# INLINE singleMaybe #-}-singleMaybe :: QueryReader a -> Entities -> (Maybe a, Entities)-singleMaybe q es = let !(a, cs) = singleMaybe' q es in (a, es {E.components = cs})---- | Match a single entity.------ @since 0.10-{-# INLINE singleMaybe' #-}-singleMaybe' :: QueryReader a -> Entities -> (Maybe a, Components)-singleMaybe' q es = let !(rs, cs', dynQ) = runQueryReader q (E.components es) in (singleMaybeDyn rs dynQ es, cs')
− src/Aztecs/ECS/Query/Reader/Class.hs 
@@ -1,26 +0,0 @@--- |--- Module      : Aztecs.ECS.Query.Reader.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Reader.Class (QueryReaderF (..)) where--import Aztecs.ECS.Component---- | Query reader functor.------ @since 0.10-class (Functor f) => QueryReaderF f where-  -- | Fetch a `Component` by its type.-  ---  -- @since 0.10-  fetch :: (Component a) => f a--  -- | Fetch a `Component` by its type, returning `Nothing` if it doesn't exist.-  ---  -- @since 0.10-  fetchMaybe :: (Component a) => f (Maybe a)-  fetchMaybe = Just <$> fetch
src/Aztecs/ECS/System.hs view
@@ -1,8 +1,11 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}  -- | -- Module      : Aztecs.ECS.System@@ -13,151 +16,201 @@ -- Stability   : provisional -- Portability : non-portable (GHC extensions) ----- Systems to process queries in parallel.+-- Systems to process entities. module Aztecs.ECS.System-  ( System,+  ( -- * Systems+    System,     SystemT (..),-    MonadReaderSystem (..),-    MonadSystem (..),-    MonadDynamicReaderSystem (..),-    MonadDynamicSystem (..),++    -- ** Reading+    readQuery,+    allDyn,+    readQueryEntities,++    -- ** Writing+    query,+    querySingleMaybe,+    queryDyn,+    querySingleMaybeDyn,++    -- ** Running+    runSystemT,+    concurrently,++    -- * Internal+    Job (..),+    Task (..),   ) where -import Aztecs.ECS.Component-import Aztecs.ECS.Query-import qualified Aztecs.ECS.Query as Q-import Aztecs.ECS.Query.Dynamic (DynamicQueryT)-import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReader (..))-import Aztecs.ECS.Query.Reader-import Aztecs.ECS.System.Class-import Aztecs.ECS.System.Dynamic.Class-import Aztecs.ECS.System.Dynamic.Reader.Class-import Aztecs.ECS.System.Reader.Class+import Aztecs.ECS.Entity (EntityID)+import Aztecs.ECS.Query (QueryT (..))+import Aztecs.ECS.Query.Dynamic (DynamicQueryT, queryFilter, readDynQuery, readDynQueryEntities) import qualified Aztecs.ECS.View as V import qualified Aztecs.ECS.World.Archetype as A-import Aztecs.ECS.World.Archetypes (Node (..)) import Aztecs.ECS.World.Entities (Entities (..))-import Control.Category-import Control.Concurrent.STM+import Control.Concurrent (forkIO)+import Control.Concurrent.MVar import Control.Monad.Identity-import Control.Monad.Reader-import qualified Data.Foldable as F+import Control.Monad.Trans+import Data.Kind import qualified Data.Map as Map-import Data.Set (Set)-import Prelude hiding (all, filter, id, map, (.)) --- | @since 0.9-type System = SystemT STM+-- | System task.+--+-- @since 0.11+newtype Task t (m :: Type -> Type) a+  = Task {runTask :: ((Entities -> Entities) -> t m Entities) -> t m a}+  deriving (Functor) --- | System to process queries in parallel.+-- | Job to be interpreted. ----- @since 0.9-newtype SystemT m a = SystemT-  { -- | Run a system on a collection of `Entities`.-    ---    -- @since 0.9-    runSystemT :: ReaderT (TVar Entities) m a-  }-  deriving (Functor, Applicative, Monad)+-- @since 0.11+data Job t m a where+  Pure :: a -> Job t m a+  Map :: (a -> b) -> Job t m a -> Job t m b+  Ap :: Job t m (a -> b) -> Job t m a -> Job t m b+  Bind :: Job t m a -> (a -> Job t m b) -> Job t m b+  Once :: Task t m a -> Job t m a --- | @since 0.9-instance MonadDynamicSystem (DynamicQueryT STM) System where-  mapDyn cIds q = SystemT $ do-    wVar <- ask-    w <- lift $ readTVar wVar-    let !v = V.view cIds $ archetypes w-    (o, v') <- lift $ V.mapDyn q v-    lift . modifyTVar wVar $ V.unview v'-    return o-  mapSingleMaybeDyn cIds q = SystemT $ do-    wVar <- ask-    w <- lift $ readTVar wVar-    case V.viewSingle cIds $ archetypes w of-      Just v -> do-        (o, v') <- lift $ V.mapSingleDyn q v-        lift . modifyTVar wVar $ V.unview v'-        return o-      Nothing -> return Nothing-  filterMapDyn cIds f q = SystemT $ do-    wVar <- ask-    w <- lift $ readTVar wVar-    let !v = V.filterView cIds f $ archetypes w-    (o, v') <- lift $ V.mapDyn q v-    lift . modifyTVar wVar $ V.unview v'-    return o+type System = SystemT Identity --- | @since 0.9-instance MonadSystem (QueryT STM) System where-  map q = SystemT $ do-    (rws, dynQ) <- runSystemT $ fromQuery q-    runSystemT $ mapDyn (Q.reads rws <> Q.writes rws) dynQ-  mapSingleMaybe q = SystemT $ do-    (rws, dynQ) <- runSystemT $ fromQuery q-    runSystemT $ mapSingleMaybeDyn (Q.reads rws <> Q.writes rws) dynQ-  filterMap q qf = SystemT $ do-    wVar <- ask-    let go w =-          let (rws, cs', dynQ) = runQuery q $ components w-              (dynF, cs'') = runQueryFilter qf cs'-           in ((rws, dynQ, dynF), w {components = cs''})-    (rws, dynQ, dynF) <- lift $ stateTVar wVar go-    let f' n =-          F.all (\cId -> A.member cId $ nodeArchetype n) (filterWith dynF)-            && F.all (\cId -> not (A.member cId $ nodeArchetype n)) (filterWithout dynF)-    runSystemT $ filterMapDyn (Q.reads rws <> Q.writes rws) f' dynQ+-- | System to process entities.+--+-- @since 0.11+newtype SystemT m a+  = System {unSystem :: forall t. (MonadTrans t, Monad (t m)) => Job t m a} --- | @since 0.9-instance MonadReaderSystem QueryReader System where-  all q = SystemT $ do-    (cIds, dynQ) <- runSystemT $ fromQueryReader q-    runSystemT $ allDyn cIds dynQ-  filter q qf = SystemT $ do-    wVar <- ask-    let go w =-          let (cIds, cs', dynQ) = runQueryReader q $ components w-              (dynF, cs'') = runQueryFilter qf cs'-           in ((cIds, dynQ, dynF), w {components = cs''})-    (cIds, dynQ, dynF) <- lift $ stateTVar wVar go-    let f' n =-          F.all (\cId -> A.member cId $ nodeArchetype n) (filterWith dynF)-            && F.all (\cId -> not (A.member cId $ nodeArchetype n)) (filterWithout dynF)-    runSystemT $ filterDyn cIds dynQ f'+-- | @since 0.11+instance Functor (SystemT m) where+  fmap f (System s) = System $ Map f s --- | @since 0.9-instance MonadDynamicReaderSystem DynamicQueryReader System where-  allDyn cIds q = SystemT $ do-    wVar <- ask-    w <- lift $ readTVar wVar-    let !v = V.view cIds $ archetypes w-    return $-      if V.null v-        then runDynQueryReader q A.empty {A.entities = Map.keysSet $ entities w}-        else V.allDyn q v-  filterDyn cIds q f = SystemT $ do-    wVar <- ask-    w <- lift $ readTVar wVar-    let !v = V.filterView cIds f $ archetypes w-    return $ V.allDyn q v+-- | @since 0.11+instance (Monad m) => Applicative (SystemT m) where+  pure a = System $ Pure a+  (System f) <*> (System g) = System $ Ap f g --- | Convert a `QueryReaderT` to a `System`.+-- | @since 0.11+instance (Monad m) => Monad (SystemT m) where+  (System a) >>= f = System $ Bind a (unSystem . f)++-- | @since 0.11+instance (MonadIO m) => MonadIO (SystemT m) where+  liftIO m = System $ Once . Task . const . lift $ liftIO m++-- | Map all entities with a `DynamicQueryT`. ----- @since 0.9-fromQueryReader :: QueryReader a -> System (Set ComponentID, DynamicQueryReader a)-fromQueryReader q = SystemT $ do-  wVar <- ask-  let go w =-        let (cIds, cs', dynQ) = runQueryReader q $ components w-         in ((cIds, dynQ), w {components = cs'})-  lift $ stateTVar wVar go+-- @since 0.11+queryDyn :: (Monad m) => DynamicQueryT m a -> SystemT m [a]+queryDyn q = System $ Once . Task $ \f -> do+  w <- f id+  let qf = queryFilter q+      !v = V.view qf $ archetypes w+  (o, v') <- lift $ V.mapDyn q v+  _ <- f $ V.unview v'+  return o +-- | Map a single entity with a `DynamicQueryT`.+--+-- @since 0.11+querySingleMaybeDyn :: (Monad m) => DynamicQueryT m a -> SystemT m (Maybe a)+querySingleMaybeDyn q = System $ Once . Task $ \f -> do+  w <- f id+  let qf = queryFilter q+  case V.viewSingle qf $ archetypes w of+    Just v -> do+      (o, v') <- lift $ V.mapSingleDyn q v+      _ <- f $ V.unview v'+      return o+    Nothing -> return Nothing++-- | Match and update all entities with a `QueryT`.+--+-- @since 0.11+query :: (Monad m) => QueryT m a -> SystemT m [a]+query q = do+  dynQ <- fromQuery q+  queryDyn dynQ++-- | Match and update a single entity with a `QueryT`, or @Nothing@.+--+-- @since 0.11+querySingleMaybe :: (Monad m) => QueryT m a -> SystemT m (Maybe a)+querySingleMaybe q = do+  dynQ <- fromQuery q+  querySingleMaybeDyn dynQ++-- | Match all entities with a `QueryT`.+--+-- @since 0.11+readQuery :: (Monad m) => QueryT m a -> SystemT m [a]+readQuery q = do+  dynQ <- fromQuery q+  allDyn dynQ++-- | Match entities with a `QueryT`.+--+-- @since 0.11+readQueryEntities :: (Monad m) => [EntityID] -> QueryT m a -> SystemT m [a]+readQueryEntities es q = fromQuery q >>= queryEntitiesDyn es++allDyn :: (Monad m) => DynamicQueryT m a -> SystemT m [a]+allDyn q = System $ Once . Task $ \f -> do+  w <- f id+  let qf = queryFilter q+      !v = V.view qf $ archetypes w+  lift $+    if V.null v+      then readDynQuery q $ A.empty {A.entities = Map.keysSet $ entities w}+      else V.allDyn q v++queryEntitiesDyn :: (Monad m) => [EntityID] -> DynamicQueryT m a -> SystemT m [a]+queryEntitiesDyn es q = System $ Once . Task $ \f -> do+  w <- f id+  let qf = queryFilter q+      !v = V.view qf $ archetypes w+  lift $+    if V.null v+      then readDynQueryEntities es q $ A.empty {A.entities = Map.keysSet $ entities w}+      else V.allDyn q v+ -- | Convert a `QueryT` to a `System`. ----- @since 0.9-fromQuery :: QueryT STM a -> System (ReadsWrites, DynamicQueryT STM a)-fromQuery q = SystemT $ do-  wVar <- ask-  let go w =-        let (rws, cs', dynQ) = runQuery q $ components w-         in ((rws, dynQ), w {components = cs'})-  lift $ stateTVar wVar go+-- @since 0.11+fromQuery :: (Monad m) => QueryT m a -> SystemT m (DynamicQueryT m a)+fromQuery q = System $ Once . Task $ \f -> do+  w <- f id+  let (cs', dynQ) = runQuery q $ components w+  _ <- f $ const w {components = cs'}+  return dynQ++runSystemT :: (MonadTrans t, Monad (t m), Monad m) => SystemT m a -> ((Entities -> Entities) -> t m Entities) -> t m a+runSystemT (System s) = runJob s++runJob :: (MonadTrans t, Monad (t m), Monad m) => Job t m a -> ((Entities -> Entities) -> t m Entities) -> t m a+runJob (Pure a) _ = return a+runJob (Map f' s') f = f' <$> runJob s' f+runJob (Ap f' a) f = runJob f' f <*> runJob a f+runJob (Bind a f') f = runJob a f >>= \a' -> runJob (f' a') f+runJob (Once (Task t)) f = t f++concurrently :: SystemT IO a -> ((Entities -> Entities) -> IO Entities) -> IO a+concurrently (System s) f = runJobConcurrently s $ lift . f++runJobConcurrently :: Job IdentityT IO a -> ((Entities -> Entities) -> IdentityT IO Entities) -> IO a+runJobConcurrently (Pure a) _ = return a+runJobConcurrently (Map f' s') f = f' <$> runJobConcurrently s' f+runJobConcurrently (Ap f' a) f = do+  aVar <- newEmptyMVar+  fVar <- newEmptyMVar+  _ <- forkIO $ do+    f'' <- runJobConcurrently f' f+    putMVar fVar f''+  _ <- forkIO $ do+    a' <- runJobConcurrently a f+    putMVar aVar a'+  a' <- takeMVar aVar+  f'' <- takeMVar fVar+  return $ f'' a'+runJobConcurrently (Bind a f') f = runJobConcurrently a f >>= \a' -> runJobConcurrently (f' a') f+runJobConcurrently (Once (Task t)) f = runIdentityT $ t f
− src/Aztecs/ECS/System/Class.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}---- |--- Module      : Aztecs.ECS.System.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.System.Class (MonadSystem (..)) where--import Aztecs.ECS.Query.Reader (QueryFilter (..))-import GHC.Stack-import Prelude hiding (map)---- | Monadic system.------ @since 0.9-class (Monad m) => MonadSystem q m | m -> q where-  -- | Map all matching entities with a query.-  ---  -- @since 0.9-  map :: q a -> m [a]--  -- | Map a single matching entity with a query, or @Nothing@.-  ---  -- @since 0.9-  mapSingleMaybe :: q a -> m (Maybe a)--  -- | Map a single matching entity with a query.-  ---  -- @since 0.9-  mapSingle :: (HasCallStack) => q a -> m a-  mapSingle q = do-    res <- mapSingleMaybe q-    case res of-      Just a -> return a-      Nothing -> error "Expected a single matching entity."--  -- | Map all matching entities with a query and filter.-  ---  -- @since 0.9-  filterMap :: q a -> QueryFilter -> m [a]
− src/Aztecs/ECS/System/Dynamic/Class.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}---- |--- Module      : Aztecs.ECS.System.Dynamic.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.System.Dynamic.Class (MonadDynamicSystem (..)) where--import Aztecs.ECS.Component (ComponentID)-import Aztecs.ECS.World.Archetypes (Node (..))-import Data.Set (Set)-import GHC.Stack---- | Monadic dynamic system.------ @since 0.9-class (Monad m) => MonadDynamicSystem q m | m -> q where-  -- | Map all matching entities with a query.-  ---  -- @since 0.9-  mapDyn :: Set ComponentID -> q a -> m [a]--  -- | Map a single matching entity with a query, or @Nothing@.-  ---  -- @since 0.9-  mapSingleMaybeDyn :: Set ComponentID -> q a -> m (Maybe a)--  -- | Map a single matching entity with a query.-  mapSingleDyn :: (HasCallStack) => Set ComponentID -> q a -> m a-  mapSingleDyn cIds q = do-    res <- mapSingleMaybeDyn cIds q-    case res of-      Just a -> return a-      Nothing -> error "Expected a single matching entity."--  -- | Map all matching entities with a query and filter.-  ---  -- @since 0.9-  filterMapDyn :: Set ComponentID -> (Node -> Bool) -> q a -> m [a]
− src/Aztecs/ECS/System/Dynamic/Reader/Class.hs 
@@ -1,50 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}---- |--- Module      : Aztecs.ECS.System.Dynamic.Reader.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.System.Dynamic.Reader.Class (MonadDynamicReaderSystem (..)) where--import Aztecs.ECS.Component-import Aztecs.ECS.World.Archetypes (Node)-import Data.Set (Set)-import GHC.Stack---- | Monadic dynamic reader system.------ @since 0.9-class (Monad m) => MonadDynamicReaderSystem q m | m -> q where-  -- | Match all entities with a query.-  ---  -- @since 0.9-  allDyn :: Set ComponentID -> q a -> m [a]--  -- | Match a single entity with a query.-  ---  -- @since 0.9-  singleDyn :: (HasCallStack) => Set ComponentID -> q a -> m a-  singleDyn cIds q = do-    os <- allDyn cIds q-    case os of-      [o] -> return o-      _ -> error "singleDyn: expected a single result, but got multiple"--  -- | Match a single entity with a query, or Nothing.-  ---  -- @since 0.9-  singleMaybeDyn :: Set ComponentID -> q a -> m (Maybe a)-  singleMaybeDyn cIds q = do-    os <- allDyn cIds q-    return $ case os of-      [o] -> Just o-      _ -> Nothing--  -- | Match all entities with a query and filter.-  ---  -- @since 0.9-  filterDyn :: Set ComponentID -> q a -> (Node -> Bool) -> m [a]
− src/Aztecs/ECS/System/Reader/Class.hs 
@@ -1,49 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}---- |--- Module      : Aztecs.ECS.System.Reader.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.System.Reader.Class (MonadReaderSystem (..)) where--import Aztecs.ECS.Query.Reader (QueryFilter (..))-import GHC.Stack-import Prelude hiding (all)---- | Monadic reader system.------ @since 0.9-class (Monad m) => MonadReaderSystem q m | m -> q where-  -- | Match all entities with a query.-  ---  -- @since 0.9-  all :: q a -> m [a]--  -- | Match a single entity with a query.-  ---  -- @since 0.9-  single :: (HasCallStack) => q a -> m a-  single q = do-    os <- all q-    case os of-      [o] -> return o-      _ -> error "single: expected a single result"--  -- | Match a single entity with a query, or @Nothing@.-  ---  -- @since 0.9-  singleMaybe :: q a -> m (Maybe a)-  singleMaybe q = do-    os <- all q-    return $ case os of-      [o] -> Just o-      _ -> Nothing--  -- | Match all entities with a query and filter.-  ---  -- @since 0.9-  filter :: q a -> QueryFilter -> m [a]
src/Aztecs/ECS/View.hs view
@@ -15,7 +15,6 @@   ( View (..),     view,     viewSingle,-    filterView,     null,     unview,     allDyn,@@ -25,17 +24,14 @@   ) where -import Aztecs.ECS.Query.Dynamic (DynamicQueryT (..))-import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReader (..))+import Aztecs.ECS.Query.Dynamic (DynamicQueryT (..), QueryFilter (filterWith, filterWithout), readDynQuery, runDynQuery) import Aztecs.ECS.World.Archetypes import qualified Aztecs.ECS.World.Archetypes as AS-import Aztecs.ECS.World.Components import Aztecs.ECS.World.Entities (Entities) import qualified Aztecs.ECS.World.Entities as E import Data.Foldable (foldl', foldlM) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map-import Data.Set (Set) import Prelude hiding (null)  -- | View into a `World`, containing a subset of archetypes.@@ -52,27 +48,17 @@ -- | View into all archetypes containing the provided component IDs. -- -- @since 0.9-view :: Set ComponentID -> Archetypes -> View-view cIds as = View $ AS.find cIds as+view :: QueryFilter -> Archetypes -> View+view qf as = View $ AS.find (filterWith qf) (filterWithout qf) as  -- | View into a single archetype containing the provided component IDs. -- -- @since 0.9-viewSingle :: Set ComponentID -> Archetypes -> Maybe View-viewSingle cIds as = case Map.toList $ AS.find cIds as of+viewSingle :: QueryFilter -> Archetypes -> Maybe View+viewSingle qf as = case Map.toList $ AS.find (filterWith qf) (filterWithout qf) as of   [a] -> Just . View $ uncurry Map.singleton a   _ -> Nothing --- | View into all archetypes containing the provided component IDs and matching the provided predicate.------ @since 0.9-filterView ::-  Set ComponentID ->-  (Node -> Bool) ->-  Archetypes ->-  View-filterView cIds f as = View $ Map.filter f (AS.find cIds as)- -- | @True@ if the `View` is empty. -- -- @since 0.9@@ -95,12 +81,12 @@ -- | Query all matching entities in a `View`. -- -- @since 0.9-allDyn :: DynamicQueryReader a -> View -> [a]+allDyn :: (Monad m) => DynamicQueryT m a -> View -> m [a] allDyn q v =-  foldl'-    ( \acc n ->-        let as = runDynQueryReader q $ nodeArchetype n-         in as ++ acc+  foldlM+    ( \acc n -> do+        as <- readDynQuery q $ nodeArchetype n+        return $ as ++ acc     )     []     (viewArchetypes v)@@ -108,10 +94,12 @@ -- | Query all matching entities in a `View`. -- -- @since 0.9-singleDyn :: DynamicQueryReader a -> View -> Maybe a-singleDyn q v = case allDyn q v of-  [a] -> Just a-  _ -> Nothing+singleDyn :: (Monad m) => DynamicQueryT m a -> View -> m (Maybe a)+singleDyn q v = do+  as <- allDyn q v+  return $ case as of+    [a] -> Just a+    _ -> Nothing  -- | Map all matching entities in a `View`. --
src/Aztecs/ECS/World/Archetype.hs view
@@ -35,8 +35,9 @@     insertComponent,     insertComponents,     insertAscList,+    map,+    mapM,     zipWith,-    zipWith_,     zipWithM,   ) where@@ -48,7 +49,8 @@ import qualified Aztecs.ECS.World.Storage.Dynamic as S import Control.DeepSeq import Control.Monad.Writer-  ( MonadWriter (..),+  ( MonadTrans (..),+    MonadWriter (..),     WriterT (..),     runWriter,   )@@ -62,7 +64,7 @@ import Data.Set (Set) import qualified Data.Set as Set import GHC.Generics-import Prelude hiding (map, zipWith)+import Prelude hiding (map, mapM, zipWith)  -- | Archetype of entities and components. -- An archetype is guranteed to contain one of each stored component per entity.@@ -154,29 +156,82 @@ member :: ComponentID -> Archetype -> Bool member cId = IntMap.member (unComponentId cId) . storages --- | Zip a list of components with a function and a component storage.+-- | Map a list of components with a function and a component storage. --+-- @since 0.11+{-# INLINE map #-}+map ::+  forall a. (Component a) => (a -> a) -> ComponentID -> Archetype -> ([a], Archetype)+map f cId arch =+  let go maybeDyn = case maybeDyn of+        Just dyn -> case fromDynamic $ storageDyn dyn of+          Just s -> do+            let !(as, s') = S.map @a @(StorageT a) f s+            tell as+            return $ Just $ dyn {storageDyn = toDyn s'}+          Nothing -> return maybeDyn+        Nothing -> return Nothing+      !(storages', cs) = runWriter $ IntMap.alterF go (unComponentId cId) $ storages arch+   in (cs, arch {storages = storages'})++-- | Map a list of components with a monadic function.+--+-- @since 0.11+{-# INLINE mapM #-}+mapM ::+  forall m a.+  (Monad m, Component a) =>+  (a -> m a) ->+  ComponentID ->+  Archetype ->+  m ([a], Archetype)+mapM f cId arch = do+  let go maybeDyn = case maybeDyn of+        Just dyn -> case fromDynamic $ storageDyn dyn of+          Just s -> do+            (as, s') <- lift $ S.mapM @a @(StorageT a) f s+            tell as+            return $ Just $ dyn {storageDyn = toDyn s'}+          Nothing -> return maybeDyn+        Nothing -> return Nothing+  (storages', cs) <- runWriterT $ IntMap.alterF go (unComponentId cId) $ storages arch+  return (cs, arch {storages = storages'})++-- | Zip a list of components with a function.+-- -- @since 0.9 {-# INLINE zipWith #-} zipWith ::-  forall a c. (Component c) => [a] -> (a -> c -> c) -> ComponentID -> Archetype -> ([c], Archetype)+  forall a b c.+  (Component c) =>+  [a] ->+  (a -> c -> (b, c)) ->+  ComponentID ->+  Archetype ->+  ([(b, c)], Archetype) zipWith as f cId arch =   let go maybeDyn = case maybeDyn of         Just dyn -> case fromDynamic $ storageDyn dyn of           Just s -> do-            let !(cs', s') = S.zipWith @c @(StorageT c) f as s-            tell cs'+            let !(acs, s') = S.zipWith @c @(StorageT c) f as s+            tell acs             return $ Just $ dyn {storageDyn = toDyn s'}           Nothing -> return maybeDyn         Nothing -> return Nothing       !(storages', cs) = runWriter $ IntMap.alterF go (unComponentId cId) $ storages arch    in (cs, arch {storages = storages'}) --- | Zip a list of components with a monadic function and a component storage.+-- | Zip a list of components with a monadic function . -- -- @since 0.9 zipWithM ::-  forall m a c. (Applicative m, Component c) => [a] -> (a -> c -> m c) -> ComponentID -> Archetype -> m ([c], Archetype)+  forall m a b c.+  (Applicative m, Component c) =>+  [a] ->+  (a -> c -> m (b, c)) ->+  ComponentID ->+  Archetype ->+  m ([(b, c)], Archetype) zipWithM as f cId arch = do   let go maybeDyn = case maybeDyn of         Just dyn -> case fromDynamic $ storageDyn dyn of@@ -189,21 +244,6 @@         Nothing -> pure Nothing   res <- runWriterT $ IntMap.alterF go (unComponentId cId) $ storages arch   return (snd res, arch {storages = fst res})---- | Zip a list of components with a function and a component storage.------ @since 0.9-{-# INLINE zipWith_ #-}-zipWith_ ::-  forall a c. (Component c) => [a] -> (a -> c -> c) -> ComponentID -> Archetype -> Archetype-zipWith_ as f cId arch =-  let maybeStorage = case IntMap.lookup (unComponentId cId) $ storages arch of-        Just dyn -> case fromDynamic $ storageDyn dyn of-          Just s ->-            let !s' = S.zipWith_ @c @(StorageT c) f as s in Just $ dyn {storageDyn = toDyn s'}-          Nothing -> Nothing-        Nothing -> Nothing-   in (empty {storages = maybe IntMap.empty (IntMap.singleton (unComponentId cId)) maybeStorage})  -- | Insert a list of components into the archetype, sorted in ascending order by their `EntityID`. --
src/Aztecs/ECS/World/Archetypes.hs view
@@ -29,7 +29,6 @@     findArchetypeIds,     lookup,     find,-    map,     adjustArchetype,     insert,     remove,@@ -137,29 +136,21 @@  -- | Find `ArchetypeID`s containing a set of `ComponentID`s. ----- @since 0.9-findArchetypeIds :: Set ComponentID -> Archetypes -> Set ArchetypeID-findArchetypeIds cIds arches = case mapMaybe (\cId -> Map.lookup cId (componentIds arches)) (Set.elems cIds) of-  (aId : aIds') -> foldl' Set.intersection aId aIds'-  [] -> Set.empty+-- @since 0.11+findArchetypeIds :: Set ComponentID -> Set ComponentID -> Archetypes -> Set ArchetypeID+findArchetypeIds w wo arches =+  let !withIds = mapMaybe (\cId -> Map.lookup cId (componentIds arches)) (Set.elems w)+      !withoutIds = mapMaybe (\cId -> Map.lookup cId (componentIds arches)) (Set.elems wo)+      !withoutSet = foldl' Set.union Set.empty withoutIds+   in case withIds of+        (aId : aIds') -> foldl' Set.intersection aId aIds' `Set.difference` withoutSet+        [] -> Set.empty  -- | Lookup `Archetype`s containing a set of `ComponentID`s. -- -- @since 0.9-find :: Set ComponentID -> Archetypes -> Map ArchetypeID Node-find cIds arches = Map.fromSet (\aId -> nodes arches Map.! aId) (findArchetypeIds cIds arches)---- | Map over `Archetype`s containing a set of `ComponentID`s.------ @since 0.9-map :: Set ComponentID -> (Archetype -> (a, Archetype)) -> Archetypes -> ([a], Archetypes)-map cIds f arches =-  let go (acc, archAcc) aId =-        let !node = nodes archAcc Map.! aId-            !(a, arch') = f (nodeArchetype node)-            nodes' = Map.insert aId (node {nodeArchetype = arch'}) (nodes archAcc)-         in (a : acc, archAcc {nodes = nodes'})-   in foldl' go ([], arches) $ findArchetypeIds cIds arches+find :: Set ComponentID -> Set ComponentID -> Archetypes -> Map ArchetypeID Node+find w wo arches = Map.fromSet (\aId -> nodes arches Map.! aId) (findArchetypeIds w wo arches)  -- | Lookup an `ArchetypeID` by its set of `ComponentID`s. --
src/Aztecs/ECS/World/Bundle.hs view
@@ -1,6 +1,4 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}@@ -17,8 +15,8 @@ -- Portability : non-portable (GHC extensions) module Aztecs.ECS.World.Bundle   ( Bundle (..),-    MonoidBundle (..),-    MonoidDynamicBundle (..),+    bundle,+    fromDynBundle,     runBundle,   ) where@@ -26,7 +24,6 @@ import Aztecs.ECS.Component import Aztecs.ECS.Entity import Aztecs.ECS.World.Archetype-import Aztecs.ECS.World.Bundle.Class import Aztecs.ECS.World.Bundle.Dynamic import Aztecs.ECS.World.Components import qualified Aztecs.ECS.World.Components as CS@@ -54,15 +51,13 @@         (cIds2, cs'', d2) = b2 cs'      in (cIds1 <> cIds2, cs'', d1 <> d2) --- | @since 0.9-instance MonoidBundle Bundle where-  bundle :: forall a. (Component a) => a -> Bundle-  bundle a = Bundle $ \cs ->-    let (cId, cs') = CS.insert @a cs in (Set.singleton cId, cs', dynBundle cId a)+-- | @since 0.11+bundle :: forall a. (Component a) => a -> Bundle+bundle a = Bundle $ \cs ->+  let (cId, cs') = CS.insert @a cs in (Set.singleton cId, cs', dynBundle cId a) --- | @since 0.9-instance MonoidDynamicBundle Bundle where-  dynBundle cId c = Bundle (Set.singleton cId,,dynBundle cId c)+fromDynBundle :: DynamicBundle -> Bundle+fromDynBundle d = Bundle (Set.empty,,d)  -- | Insert a bundle of components into an archetype. --
− src/Aztecs/ECS/World/Bundle/Class.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}---- |--- Module      : Aztecs.ECS.World.Bundle.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.World.Bundle.Class (MonoidBundle (..)) where--import Aztecs.ECS.Component---- | Monoid bundle of components.------ @since 0.9-class (Monoid a) => MonoidBundle a where-  -- | Add a component to the bundle.-  ---  -- @since 0.9-  bundle :: forall c. (Component c) => c -> a
src/Aztecs/ECS/World/Bundle/Dynamic.hs view
@@ -6,11 +6,11 @@ -- Maintainer  : matt@hunzinger.me -- Stability   : provisional -- Portability : non-portable (GHC extensions)-module Aztecs.ECS.World.Bundle.Dynamic (DynamicBundle (..), MonoidDynamicBundle (..)) where+module Aztecs.ECS.World.Bundle.Dynamic (DynamicBundle (..), dynBundle) where +import Aztecs.ECS.Component import Aztecs.ECS.Entity import Aztecs.ECS.World.Archetype-import Aztecs.ECS.World.Bundle.Dynamic.Class  -- | Dynamic bundle of components. --@@ -25,6 +25,6 @@ instance Monoid DynamicBundle where   mempty = DynamicBundle $ \_ arch -> arch --- | @since 0.9-instance MonoidDynamicBundle DynamicBundle where-  dynBundle cId a = DynamicBundle $ \eId arch -> insertComponent eId cId a arch+-- | @since 0.11+dynBundle :: (Component a) => ComponentID -> a -> DynamicBundle+dynBundle cId a = DynamicBundle $ \eId arch -> insertComponent eId cId a arch
− src/Aztecs/ECS/World/Bundle/Dynamic/Class.hs 
@@ -1,20 +0,0 @@--- |--- Module      : Aztecs.ECS.World.Bundle.Dynamic.Class--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.ECS.World.Bundle.Dynamic.Class (MonoidDynamicBundle (..)) where--import Aztecs.ECS.Component---- | Monoid bundle of dynamic components.------ @since 0.9-class MonoidDynamicBundle a where-  -- | Add a component to the bundle by its `ComponentID`.-  ---  -- @since 0.9-  dynBundle :: (Component c) => ComponentID -> c -> a
src/Aztecs/ECS/World/Storage.hs view
@@ -13,6 +13,7 @@  import Control.DeepSeq import qualified Control.Monad+import qualified Control.Monad as M import Data.Data import Prelude hiding (zipWith) import qualified Prelude@@ -39,26 +40,25 @@   -- | Map a function over all components in the storage.   --   ---  -- @since 0.9-  map :: (a -> a) -> s -> s+  -- @since 0.11+  map :: (a -> a) -> s -> ([a], s) -  -- | Map a function with some input over all components in the storage.+  -- | Map a monadic function over all components in the storage.   ---  -- @since 0.9-  zipWith :: (i -> a -> a) -> [i] -> s -> ([a], s)+  -- @since 0.11+  mapM :: (Monad m) => (a -> m a) -> s -> m ([a], s) -  -- | Map an applicative functor with some input over all components in the storage.+  -- | Map a function with some input over all components in the storage.   ---  -- @since 0.9-  zipWithM :: (Applicative m) => (i -> a -> m a) -> [i] -> s -> m ([a], s)+  -- @since 0.11+  zipWith :: (b -> a -> (c, a)) -> [b] -> s -> ([(c, a)], s) -  -- | Map a function with some input over all components in the storage.+  -- | Map an applicative functor with some input over all components in the storage.   ---  -- @since 0.9-  zipWith_ :: (i -> a -> a) -> [i] -> s -> s-  zipWith_ f is as = snd $ zipWith f is as+  -- @since 0.11+  zipWithM :: (Applicative m) => (b -> a -> m (c, a)) -> [b] -> s -> m ([(c, a)], s) --- | @since 0.9+-- | @since 0.11 instance (Typeable a, NFData a) => Storage a [a] where   {-# INLINE singleton #-}   singleton a = [a]@@ -67,10 +67,10 @@   {-# INLINE fromAscList #-}   fromAscList = id   {-# INLINE map #-}-  map = fmap+  map f as = let as' = fmap f as in (as', as')+  {-# INLINE mapM #-}+  mapM f as = (\as' -> (as', as')) <$> M.mapM f as   {-# INLINE zipWith #-}-  zipWith f is as = let as' = Prelude.zipWith f is as in (as', as')-  {-# INLINE zipWith_ #-}-  zipWith_ = Prelude.zipWith+  zipWith f is as = let as' = Prelude.zipWith f is as in (as', fmap snd as')   {-# INLINE zipWithM #-}-  zipWithM f is as = (\as' -> (as', as')) <$> Control.Monad.zipWithM f is as+  zipWithM f is as = (\as' -> (as', fmap snd as')) <$> Control.Monad.zipWithM f is as
− src/Aztecs/Hierarchy.hs 
@@ -1,255 +0,0 @@-{-# LANGUAGE ApplicativeDo #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeApplications #-}---- |--- Module      : Aztecs.Asset.AssetServer--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)------ Hierarchical relationships.--- A `Children` component forms a one-to-many relationship with `Parent` components.-module Aztecs.Hierarchy-  ( Parent (..),-    Children (..),-    update,-    Hierarchy (..),-    toList,-    foldWithKey,-    mapWithKey,-    mapWithAccum,-    hierarchy,-    hierarchies,-    ParentState (..),-    ChildState (..),-  )-where--import Aztecs.ECS-import qualified Aztecs.ECS.Access as A-import qualified Aztecs.ECS.Query as Q-import qualified Aztecs.ECS.System as S-import Control.DeepSeq-import Control.Monad-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Maybe-import Data.Set (Set)-import qualified Data.Set as Set-import GHC.Generics---- | Parent component.------ @since 0.9-newtype Parent = Parent-  { -- | Parent entity ID.-    ---    -- @since 0.9-    unParent :: EntityID-  }-  deriving (Eq, Ord, Show, Generic, NFData)---- | @since 0.9-instance Component Parent---- | Parent internal state component.------ @since 0.9-newtype ParentState = ParentState {unParentState :: EntityID}-  deriving (Show, Generic, NFData)---- | @since 0.9-instance Component ParentState---- | Children component.------ @since 0.9-newtype Children = Children {unChildren :: Set EntityID}-  deriving (Eq, Ord, Show, Semigroup, Monoid, Generic, NFData)---- | @since 0.9-instance Component Children---- | Child internal state component.-newtype ChildState = ChildState {unChildState :: Set EntityID}-  deriving (Show, Generic, NFData)---- | @since 0.9-instance Component ChildState---- | Update the parent-child relationships.------ @since 0.9-update ::-  ( Applicative qr,-    QueryReaderF qr,-    DynamicQueryReaderF qr,-    MonadReaderSystem qr s,-    MonadAccess b m-  ) =>-  s (m ())-update = do-  parents <- S.all $ do-    entity <- Q.entity-    parent <- Q.fetch-    maybeParentState <- Q.fetchMaybe @_ @ParentState-    return (entity, unParent parent, maybeParentState)--  children <- S.all $ do-    entity <- Q.entity-    cs <- Q.fetch-    maybeChildState <- Q.fetchMaybe @_ @ChildState-    return (entity, unChildren cs, maybeChildState)--  let go = do-        mapM_-          ( \(entity, parent, maybeParentState) -> case maybeParentState of-              Just (ParentState parentState) -> do-                when (parent /= parentState) $ do-                  A.insert parent . bundle $ ParentState parent--                  -- Remove this entity from the previous parent's children.-                  maybeLastChildren <- A.lookup parentState-                  let lastChildren = maybe mempty unChildren maybeLastChildren-                  let lastChildren' = Set.filter (/= entity) lastChildren-                  A.insert parentState . bundle . Children $ lastChildren'--                  -- Add this entity to the new parent's children.-                  maybeChildren <- A.lookup parent-                  let parentChildren = maybe mempty unChildren maybeChildren-                  A.insert parent . bundle . Children $ Set.insert entity parentChildren-              Nothing -> do-                A.spawn_ . bundle $ ParentState parent-                maybeChildren <- A.lookup parent-                let parentChildren = maybe mempty unChildren maybeChildren-                A.insert parent . bundle . Children $ Set.insert entity parentChildren-          )-          parents-        mapM_-          ( \(entity, children', maybeChildState) -> case maybeChildState of-              Just (ChildState childState) -> do-                when (children' /= childState) $ do-                  A.insert entity . bundle $ ChildState children'-                  let added = Set.difference children' childState-                      removed = Set.difference childState children'-                  mapM_ (\e -> A.insert e . bundle . Parent $ entity) added-                  mapM_ (A.remove @_ @_ @Parent) removed-              Nothing -> do-                A.insert entity . bundle $ ChildState children'-                mapM_ (\e -> A.insert e . bundle . Parent $ entity) children'-          )-          children-  return go---- | Hierarchy of entities.------ @since 0.9-data Hierarchy a = Node-  { -- | Entity ID.-    ---    -- @since 0.9-    nodeEntityId :: EntityID,-    -- | Entity components.-    nodeEntity :: a,-    -- | Child nodes.-    ---    -- @since 0.9-    nodeChildren :: [Hierarchy a]-  }-  deriving (Functor)---- | @since 0.9-instance Foldable Hierarchy where-  foldMap f n = f (nodeEntity n) <> foldMap (foldMap f) (nodeChildren n)---- | @since 0.9-instance Traversable Hierarchy where-  traverse f n =-    Node (nodeEntityId n) <$> f (nodeEntity n) <*> traverse (traverse f) (nodeChildren n)---- | Convert a hierarchy to a list of entity IDs and components.------ @since 0.9-toList :: Hierarchy a -> [(EntityID, a)]-toList n = (nodeEntityId n, nodeEntity n) : concatMap toList (nodeChildren n)---- | Fold a hierarchy with a function that takes the entity ID, entity, and accumulator.------ @since 0.9-foldWithKey :: (EntityID -> a -> b -> b) -> Hierarchy a -> b -> b-foldWithKey f n b = f (nodeEntityId n) (nodeEntity n) (foldr (foldWithKey f) b (nodeChildren n))---- | Map a hierarchy with a function that takes the entity ID and entity.------ @since 0.9-mapWithKey :: (EntityID -> a -> b) -> Hierarchy a -> Hierarchy b-mapWithKey f n =-  Node (nodeEntityId n) (f (nodeEntityId n) (nodeEntity n)) (map (mapWithKey f) (nodeChildren n))---- | Map a hierarchy with a function that takes the entity ID, entity, and accumulator.------ @since 0.9-mapWithAccum :: (EntityID -> a -> b -> (c, b)) -> b -> Hierarchy a -> Hierarchy c-mapWithAccum f b n = case f (nodeEntityId n) (nodeEntity n) b of-  (c, b') -> Node (nodeEntityId n) c (map (mapWithAccum f b') (nodeChildren n))---- | System to read a hierarchy of parents to children with the given query.------ @since 0.9-hierarchy ::-  (Applicative q, QueryReaderF q, DynamicQueryReaderF q, MonadReaderSystem q s) =>-  EntityID ->-  q a ->-  s (Maybe (Hierarchy a))-hierarchy e q = do-  children <- S.all $ do-    entity <- Q.entity-    cs <- Q.fetch-    a <- q-    return (entity, (unChildren cs, a))--  let childMap = Map.fromList children-  return $ hierarchy' e childMap---- | Build all hierarchies of parents to children, joined with the given query.------ @since 0.9-hierarchies ::-  (Applicative q, QueryReaderF q, DynamicQueryReaderF q, MonadReaderSystem q s) =>-  q a ->-  s [Hierarchy a]-hierarchies q = do-  children <--    S.all-      ( do-          entity <- Q.entity-          cs <- Q.fetch-          a <- q-          return (entity, (unChildren cs, a))-      )--  let childMap = Map.fromList children-  roots <- S.filter Q.entity $ with @Children <> without @Parent-  return $ mapMaybe (`hierarchy'` childMap) roots---- | Build a hierarchy of parents to children.------ @since 0.9-hierarchy' :: EntityID -> Map EntityID (Set EntityID, a) -> Maybe (Hierarchy a)-hierarchy' e childMap = case Map.lookup e childMap of-  Just (cs, a) ->-    let bs = mapMaybe (`hierarchy'` childMap) (Set.toList cs)-     in Just-          Node-            { nodeEntityId = e,-              nodeEntity = a,-              nodeChildren = bs-            }-  Nothing -> Nothing
− src/Aztecs/Input.hs 
@@ -1,258 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}---- |--- Module      : Aztecs.Input--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Input-  ( Key (..),-    InputMotion (..),-    KeyboardInput (..),-    keyboardInput,-    isKeyPressed,-    wasKeyPressed,-    wasKeyReleased,-    handleKeyboardEvent,-    MouseButton (..),-    MouseInput (..),-    mouseInput,-    handleMouseMotion,-  )-where--import Aztecs.ECS-import Control.DeepSeq (NFData)-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Data.Set (Set)-import qualified Data.Set as Set-import GHC.Generics (Generic)-import Linear (V2 (..))-import Linear.Affine (Point (..))---- | Keyboard key.------ @since 0.9-data Key-  = KeyA-  | KeyB-  | KeyC-  | KeyD-  | KeyE-  | KeyF-  | KeyG-  | KeyH-  | KeyI-  | KeyJ-  | KeyK-  | KeyL-  | KeyM-  | KeyN-  | KeyO-  | KeyP-  | KeyQ-  | KeyR-  | KeyS-  | KeyT-  | KeyU-  | KeyV-  | KeyW-  | KeyX-  | KeyY-  | KeyZ-  | Key0-  | Key1-  | Key2-  | Key3-  | Key4-  | Key5-  | Key6-  | Key7-  | Key8-  | Key9-  | KeyF1-  | KeyF2-  | KeyF3-  | KeyF4-  | KeyF5-  | KeyF6-  | KeyF7-  | KeyF8-  | KeyF9-  | KeyF10-  | KeyF11-  | KeyF12-  | KeyEscape-  | KeyEnter-  | KeySpace-  | KeyBackspace-  | KeyTab-  | KeyCapsLock-  | KeyShift-  | KeyCtrl-  | KeyAlt-  | KeyLeft-  | KeyRight-  | KeyUp-  | KeyDown-  | KeyHome-  | KeyEnd-  | KeyPageUp-  | KeyPageDown-  | KeyInsert-  | KeyDelete-  | KeyMinus-  | KeyEquals-  | KeyBracketLeft-  | KeyBracketRight-  | KeyBackslash-  | KeySemicolon-  | KeyComma-  | KeyPeriod-  | KeySlash-  | KeyNumLock-  | KeyNumpad0-  | KeyNumpad1-  | KeyNumpad2-  | KeyNumpad3-  | KeyNumpad4-  | KeyNumpad5-  | KeyNumpad6-  | KeyNumpad7-  | KeyNumpad8-  | KeyNumpad9-  | KeyNumpadDivide-  | KeyNumpadMultiply-  | KeyNumpadMinus-  | KeyNumpadPlus-  | KeyNumpadEnter-  | KeyNumpadPeriod-  | KeySuper-  | KeyMenu-  deriving (Show, Eq, Ord, Enum, Bounded, Generic, NFData)---- | Keyboard input component.------ @since 0.9-data KeyboardInput = KeyboardInput-  { -- | Keyboard events that occured this frame.-    ---    -- @since 0.9-    keyboardEvents :: !(Map Key InputMotion),-    -- | Keys that are currently pressed.-    ---    -- @since 0.9-    keyboardPressed :: !(Set Key)-  }-  deriving (Show, Generic, NFData)---- | @since 0.9-instance Component KeyboardInput---- | Empty keyboard input.------ @since 0.9-keyboardInput :: KeyboardInput-keyboardInput = KeyboardInput Map.empty Set.empty---- | Input motion kind.------ @since 0.9-data InputMotion = Pressed | Released-  deriving (Show, Eq, Generic, NFData)---- | @True@ if this key is currently pressed.------ @since 0.9-isKeyPressed :: Key -> KeyboardInput -> Bool-isKeyPressed key kb = Set.member key $ keyboardPressed kb---- | Check for a key event that occured this frame.------ @since 0.9-keyEvent :: Key -> KeyboardInput -> Maybe InputMotion-keyEvent key kb = Map.lookup key $ keyboardEvents kb---- | @True@ if this key was pressed this frame.------ @since 0.9-wasKeyPressed :: Key -> KeyboardInput -> Bool-wasKeyPressed key kb = case keyEvent key kb of-  Just Pressed -> True-  _ -> False---- | @True@ if this key was released this frame.------ @since 0.9-wasKeyReleased :: Key -> KeyboardInput -> Bool-wasKeyReleased key kb = case keyEvent key kb of-  Just Released -> True-  _ -> False---- | Handle a keyboard event.------ @since 0.9-handleKeyboardEvent :: Key -> InputMotion -> KeyboardInput -> KeyboardInput-handleKeyboardEvent key motion kb =-  KeyboardInput-    { keyboardEvents = Map.insert key motion $ keyboardEvents kb,-      keyboardPressed = case motion of-        Pressed -> Set.insert key $ keyboardPressed kb-        Released -> Set.delete key $ keyboardPressed kb-    }---- | Mouse button kind.------ @since 0.9-data MouseButton-  = ButtonLeft-  | ButtonMiddle-  | ButtonRight-  | ButtonX1-  | ButtonX2-  | -- | An unknown mouse button.-    ButtonExtra !Int-  deriving (Eq, Ord, Show, Generic, NFData)---- | Mouse input component.------ @since 0.9-data MouseInput = MouseInput-  { -- | Mouse position in screen-space.-    ---    -- @since 0.9-    mousePosition :: !(Point V2 Int),-    -- | Mouse offset since last frame.-    ---    -- @since 0.9-    mouseOffset :: !(V2 Int),-    -- | Mouse button states.-    ---    -- @since 0.9-    mouseButtons :: !(Map MouseButton InputMotion)-  }-  deriving (Show, Generic, NFData)---- | @since 0.9-instance Component MouseInput---- | Empty mouse input.------ @since 0.9-mouseInput :: MouseInput-mouseInput = MouseInput (P 0) (V2 0 0) Map.empty---- | Handle a mouse motion event.------ @since 0.9-handleMouseMotion :: V2 Int -> MouseInput -> MouseInput-handleMouseMotion delta mouse =-  mouse-    { mouseOffset = delta,-      mousePosition = mousePosition mouse + P delta-    }
− src/Aztecs/Time.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- |--- Module      : Aztecs.Time--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Time (Time (..)) where--import Aztecs.ECS-import Control.DeepSeq-import Data.Word-import GHC.Generics---- | Time component.------ @since 0.9-newtype Time = Time-  { -- | Elapsed time (in milliseconds).-    ---    -- @since 0.9-    elapsedMS :: Word32-  }-  deriving (Eq, Ord, Num, Show, Generic, NFData)--instance Component Time
− src/Aztecs/Transform.hs 
@@ -1,169 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}---- |--- Module      : Aztecs.Transform--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Transform-  ( -- * Transform-    Transform (..),--    -- ** 2D-    Transform2D,-    transform2d,--    -- * Size-    Size (..),--    -- ** 2D-    Size2D,-    size2D,--    -- * Systems-    update,-    update2d,-    propagate,-    propagate2d,-  )-where--import Aztecs.ECS-import qualified Aztecs.ECS.Access as A-import qualified Aztecs.ECS.Query as Q-import Aztecs.Hierarchy (Hierarchy, hierarchies, mapWithAccum, toList)-import Control.DeepSeq-import GHC.Generics-import Linear---- | Transform component.------ @since 0.9-data Transform v r = Transform-  { -- | Translation.-    ---    -- @since 0.9-    transformTranslation :: !v,-    -- | Rotation.-    ---    -- @since 0.9-    transformRotation :: !r,-    -- | Scale.-    ---    -- @since 0.9-    transformScale :: !v-  }-  deriving (Eq, Show, Generic, NFData)---- | @since 0.9-instance (Num v, Num r) => Semigroup (Transform v r) where-  Transform t1 r1 s1 <> Transform t2 r2 s2 = Transform (t1 + t2) (r1 + r2) (s1 + s2)---- | @since 0.9-instance (Num v, Num r) => Monoid (Transform v r) where-  mempty = Transform 0 0 0---- | 2D transform component.------ @since 0.9-type Transform2D = Transform (V2 Int) Int---- | Empty transform.------ @since 0.9-transform2d :: Transform2D-transform2d = Transform (V2 0 0) 0 (V2 1 1)---- | @since 0.9-instance Component (Transform (V2 Int) Int)---- | Size component.------ @since 0.9-newtype Size v = Size {unSize :: v}-  deriving (Generic, NFData)---- | @since 0.9-type Size2D = Size (V2 Int)---- | Empty size.------ @since 0.9-size2D :: Size (V2 Integer)-size2D = Size (V2 0 0)---- | @since 0.9-instance Component (Size (V2 Int))---- | Propagate a hierarchy of transform components.------ @since 0.9-propagateHierarchy :: (Component a, Monoid a) => Hierarchy a -> Hierarchy a-propagateHierarchy = mapWithAccum (\_ t acc -> let t' = t <> acc in (t', t')) mempty---- | Propagate and update all hierarchies of transform components.------ @since 0.9-update ::-  forall q s b m a.-  ( Applicative q,-    QueryReaderF q,-    DynamicQueryReaderF q,-    MonadReaderSystem q s,-    Component a,-    Monoid a,-    MonadAccess b m-  ) =>-  s (m ())-update = mapM_ (\(e, a) -> A.insert e $ bundle a) . concatMap toList <$> propagate @_ @_ @a---- | Propagate and update all hierarchies of transform components.------ @since 0.9-update2d ::-  ( Applicative q,-    QueryReaderF q,-    DynamicQueryReaderF q,-    MonadReaderSystem q s,-    MonadAccess b m-  ) =>-  s (m ())-update2d = update @_ @_ @_ @_ @Transform2D---- | Propagate all hierarchies of transform components.------ @since 0.9-propagate ::-  ( Applicative q,-    QueryReaderF q,-    DynamicQueryReaderF q,-    MonadReaderSystem q s,-    Component a,-    Monoid a-  ) =>-  s [Hierarchy a]-propagate = do-  hs <- hierarchies Q.fetch-  return $ map propagateHierarchy hs---- | Propagate all hierarchies of `Transform2D` components.------ @since 0.9-propagate2d ::-  ( Applicative q,-    QueryReaderF q,-    DynamicQueryReaderF q,-    MonadReaderSystem q s-  ) =>-  s [Hierarchy Transform2D]-propagate2d = propagate
− src/Aztecs/Window.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}---- |--- Module      : Aztecs.Window--- Copyright   : (c) Matt Hunzinger, 2025--- License     : BSD-style (see the LICENSE file in the distribution)------ Maintainer  : matt@hunzinger.me--- Stability   : provisional--- Portability : non-portable (GHC extensions)-module Aztecs.Window (Window (..)) where--import Aztecs.ECS-import Control.DeepSeq-import GHC.Generics---- | Window component.------ @since 0.9-newtype Window = Window-  { -- | Window title.-    ---    -- @since 0.9-    windowTitle :: String-  }-  deriving (Show, Generic, NFData)---- | @since 0.9-instance Component Window
test/Main.hs view
@@ -9,9 +9,10 @@  module Main (main) where -import Aztecs+import Aztecs.ECS import Aztecs.ECS.Component (ComponentID (ComponentID)) import qualified Aztecs.ECS.Query as Q+import qualified Aztecs.ECS.Query.Dynamic as Q import qualified Aztecs.ECS.World as W import Control.DeepSeq import Data.Functor.Identity (Identity (runIdentity))@@ -34,11 +35,11 @@  main :: IO () main = hspec $ do-  describe "Aztecs.ECS.Query.single" $ do+  describe "Aztecs.ECS.Query.querySingle" $ do     it "queries a single entity" prop_querySingle-  describe "Aztecs.ECS.Query.mapSingle" $ do+  describe "Aztecs.ECS.Query.queryMapSingle" $ do     it "maps a single entity" $ property prop_queryMapSingle-  describe "Aztecs.ECS.Query.all" $ do+  describe "Aztecs.ECS.Query.query" $ do     it "queries an empty world" prop_queryEmpty     it "queries dynamic components" $ property prop_queryDyn     it "queries a typed component" $ property prop_queryTypedComponent@@ -55,49 +56,49 @@  prop_queryEmpty :: Expectation prop_queryEmpty =-  let res = fst $ Q.all (Q.fetch @_ @X) $ W.entities W.empty in res `shouldMatchList` []+  let res = fst . runIdentity . Q.query (fetch @_ @X) $ W.entities W.empty in res `shouldMatchList` []  -- | Query all components from a list of `ComponentID`s. queryComponentIds ::-  forall q a.-  (Applicative q, DynamicQueryReaderF q, Component a) =>+  forall f a.+  (Monad f, Component a) =>   [ComponentID] ->-  q (EntityID, [a])+  QueryT f (EntityID, [a]) queryComponentIds =   let go cId qAcc = do-        x' <- Q.fetchDyn @_ @a cId+        x' <- Q.fromDyn $ Q.fetchDyn @a cId         (e, xs) <- qAcc         return (e, x' : xs)    in foldr go ((,) <$> Q.entity <*> pure [])  prop_queryDyn :: [[X]] -> Expectation prop_queryDyn xs =-  let spawn xs' (acc, wAcc) =-        let spawn' x (bAcc, cAcc, idAcc) =-              ( dynBundle (ComponentID idAcc) x <> bAcc,+  let s xs' (acc, wAcc) =+        let s' x (bAcc, cAcc, idAcc) =+              ( fromDynBundle (dynBundle (ComponentID idAcc) x) <> bAcc,                 (x, ComponentID idAcc) : cAcc,                 idAcc + 1               )-            (b, cs, _) = foldr spawn' (mempty, [], 0) xs'+            (b, cs, _) = foldr s' (mempty, [], 0) xs'             (e, wAcc') = W.spawn b wAcc          in ((e, cs) : acc, wAcc')-      (es, w) = foldr spawn ([], W.empty) xs+      (es, w) = foldr s ([], W.empty) xs       go (e, cs) = do         let q = queryComponentIds $ map snd cs-            (res, _) = Q.all q $ W.entities w+            (res, _) = runIdentity . Q.query q $ W.entities w         return $ res `shouldContain` [(e, map fst cs)]    in mapM_ go es  prop_queryTypedComponent :: [X] -> Expectation prop_queryTypedComponent xs = do   let w = foldr (\x -> snd . W.spawn (bundle x)) W.empty xs-      (res, _) = Q.all Q.fetch $ W.entities w+      (res, _) = runIdentity . Q.query Q.fetch $ W.entities w   res `shouldMatchList` xs  prop_queryTwoTypedComponents :: [(X, Y)] -> Expectation prop_queryTwoTypedComponents xys = do   let w = foldr (\(x, y) -> snd . W.spawn (bundle x <> bundle y)) W.empty xys-      (res, _) = Q.all ((,) <$> Q.fetch <*> Q.fetch) $ W.entities w+      (res, _) = runIdentity . Q.query ((,) <$> Q.fetch <*> Q.fetch) $ W.entities w   res `shouldMatchList` xys  prop_queryThreeTypedComponents :: [(X, Y, Z)] -> Expectation@@ -108,21 +109,21 @@         y <- Q.fetch         z <- Q.fetch         pure (x, y, z)-      (res, _) = Q.all q $ W.entities w+      (res, _) = runIdentity . Q.query q $ W.entities w   res `shouldMatchList` xyzs  prop_querySingle :: Expectation prop_querySingle =   let (_, w) = W.spawn (bundle $ X 1) W.empty-      (res, _) = Q.single Q.fetch $ W.entities w+      (res, _) = runIdentity . Q.readSingle Q.fetch $ W.entities w    in res `shouldBe` X 1  prop_queryMapSingle :: Word8 -> Expectation prop_queryMapSingle n =   let (_, w) = W.spawn (bundle $ X 0) W.empty-      q = Q.adjust (\_ (X x) -> X $ x + 1) (pure ())-      w' = foldr (\_ es -> snd . runIdentity $ Q.mapSingle q es) (W.entities w) [1 .. n]-      (res, _) = Q.single Q.fetch w'+      q = Q.zipFetchMap (\_ (X x) -> X $ x + 1) (pure ())+      w' = foldr (\_ es -> snd . runIdentity $ Q.querySingle q es) (W.entities w) [1 .. n]+      (res, _) = runIdentity $ Q.readSingle Q.fetch w'    in res `shouldBe` X (fromIntegral n)  {-TODO