packages feed

aztecs 0.9.1 → 0.10.0

raw patch · 26 files changed

+554/−652 lines, 26 filesdep ~base

Dependency ranges changed: base

Files

aztecs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name:          aztecs-version:       0.9.1+version:       0.10.0 license:       BSD-3-Clause license-file:  LICENSE maintainer:    matt@hunzinger.me@@ -72,7 +72,7 @@     default-language: Haskell2010     ghc-options:      -Wall     build-depends:-        base >=4 && <5,+        base >=4.2 && <5,         containers >=0.6,         deepseq >=1,         linear >=1,@@ -87,7 +87,7 @@     default-language: Haskell2010     ghc-options:      -Wall     build-depends:-        base >=4 && <5,+        base >=4.2 && <5,         aztecs,         containers >=0.6,         deepseq >=1,@@ -101,7 +101,7 @@     default-language: Haskell2010     ghc-options:      -Wall     build-depends:-        base >=4 && <5,+        base >=4.2 && <5,         aztecs,         criterion >=1,         deepseq >=1
bench/Bench.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE Arrows #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -7,9 +6,9 @@ import qualified Aztecs.ECS.Query as Q import Aztecs.ECS.World import qualified Aztecs.ECS.World as W-import Control.Arrow import Control.DeepSeq import Criterion.Main+import Data.Function import Data.Functor.Identity import GHC.Generics @@ -21,22 +20,14 @@  instance Component Velocity -query :: Query () Position-query = Q.fetch >>> Q.adjust (\(Velocity v) (Position p) -> Position $ p + v)--queryDo :: Query () Position-queryDo = proc () -> do-  Velocity v <- Q.fetch -< ()-  Q.adjust (\v (Position p) -> Position $ p + v) -< v+query :: Query Position+query = Q.fetch & Q.adjust (\(Velocity v) (Position p) -> Position $ p + v) -run :: Query () Position -> World -> [Position]-run q = fst . runIdentity . Q.map () q . entities+run :: Query Position -> World -> [Position]+run q = fst . runIdentity . Q.map 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,-      bench "iter do-notation" $ nf (run queryDo) w-    ]+  defaultMain [bench "iter" $ nf (run query) w]
src/Aztecs/Asset/AssetLoader.hs view
@@ -1,12 +1,10 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE Arrows #-}+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}  -- | -- Module      : Aztecs.Asset.AssetLoader@@ -29,12 +27,14 @@ 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.Arrow 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 @@ -73,15 +73,27 @@ -- | Query to load assets. -- -- @since 0.9-loadQuery :: (Asset a, ArrowQuery m arr) => AssetLoader a o -> arr () o-loadQuery a = proc () -> do-  server <- Q.fetch -< ()-  let (o, server') = runState (unAssetLoader a) server-  Q.set -< server'-  returnA -< o+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 :: forall m q s a o. (ArrowQuery m q, MonadSystem q s, Asset a) => AssetLoader a o -> s o-load a = S.mapSingle @q () $ loadQuery a+load :: (MonadSystem Query s, Asset a) => AssetLoader a o -> s o+load a = S.mapSingle $ loadQuery a
src/Aztecs/Asset/AssetServer.hs view
@@ -116,8 +116,8 @@ -- | Load any pending assets. -- -- @since 0.9-loadAssets :: forall a q s m. (Typeable a, ArrowQuery m q, MonadSystem q s, MonadIO m) => s ()-loadAssets = void . S.map @q () $ Q.adjustM (\_ s -> loadAssetServer @m @a s)+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`. --
src/Aztecs/Camera.hs view
@@ -22,7 +22,6 @@ import qualified Aztecs.ECS.Query.Reader as Q import qualified Aztecs.ECS.System as S import Aztecs.Window-import Control.Arrow import Control.DeepSeq import GHC.Generics import Linear@@ -63,15 +62,16 @@ -- -- @since 0.9 addCameraTargets ::-  ( ArrowQueryReader qr,-    ArrowDynamicQueryReader qr,+  ( 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)+  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 ()
src/Aztecs/ECS.hs view
@@ -64,11 +64,10 @@     Query,     QueryT,     QueryReader,-    QueryReaderT,-    ArrowQueryReader,-    ArrowQuery,-    ArrowDynamicQueryReader,-    ArrowDynamicQuery,+    QueryReaderF,+    QueryF,+    DynamicQueryReaderF,+    DynamicQueryF,     QueryFilter,     with,     without,@@ -84,17 +83,17 @@ import Aztecs.ECS.Component (Component (..)) import Aztecs.ECS.Entity (EntityID) import Aztecs.ECS.Query-  ( ArrowDynamicQuery,-    ArrowDynamicQueryReader,-    ArrowQuery,-    ArrowQueryReader,+  ( DynamicQueryF,+    DynamicQueryReaderF,     Query,+    QueryF,     QueryFilter,+    QueryReaderF,     QueryT,     with,     without,   )-import Aztecs.ECS.Query.Reader (QueryReader, QueryReaderT)+import Aztecs.ECS.Query.Reader (QueryReader) import Aztecs.ECS.System import Aztecs.ECS.World (World) import Aztecs.ECS.World.Bundle (Bundle, MonoidBundle (..))
src/Aztecs/ECS/Access.hs view
@@ -26,7 +26,7 @@ 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 (DynamicQueryReaderT)+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@@ -98,13 +98,13 @@     put w'  -- | @since 0.9-instance (Monad m) => MonadReaderSystem (QueryReaderT m) (AccessT m) where-  all i q = AccessT $ do+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 i cIds dynQ-  filter i q f = AccessT $ do+    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@@ -112,21 +112,21 @@     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 i cIds dynQ f'+    unAccessT $ filterDyn cIds dynQ f'  -- | @since 0.9 instance (Monad m) => MonadSystem (QueryT m) (AccessT m) where-  map i q = AccessT $ do+  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 i (Q.reads rws <> Q.writes rws) dynQ-  mapSingleMaybe i q = AccessT $ do+    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 i (Q.reads rws <> Q.writes rws) dynQ-  filterMap i q f = AccessT $ do+    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@@ -134,32 +134,32 @@     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 i (Q.reads rws <> Q.writes rws) f' dynQ+    unAccessT $ filterMapDyn (Q.reads rws <> Q.writes rws) f' dynQ  -- | @since 0.9-instance (Monad m) => MonadDynamicReaderSystem (DynamicQueryReaderT m) (AccessT m) where-  allDyn i cIds q = AccessT $ do+instance (Monad m) => MonadDynamicReaderSystem DynamicQueryReader (AccessT m) where+  allDyn cIds q = AccessT $ do     !w <- get-    lift . Q.allDyn cIds i q $ entities w-  filterDyn i cIds q f = AccessT $ do+    return . Q.allDyn cIds q $ entities w+  filterDyn cIds q f = AccessT $ do     !w <- get-    lift . Q.filterDyn cIds i f q $ entities w+    return . Q.filterDyn cIds f q $ entities w  -- | @since 0.9 instance (Monad m) => MonadDynamicSystem (DynamicQueryT m) (AccessT m) where-  mapDyn i cIds q = AccessT $ do+  mapDyn cIds q = AccessT $ do     !w <- get-    (as, es) <- lift . Q.mapDyn cIds i q $ entities w+    (as, es) <- lift . Q.mapDyn cIds q $ entities w     put w {entities = es}     return as-  mapSingleMaybeDyn i cIds q = AccessT $ do+  mapSingleMaybeDyn cIds q = AccessT $ do     !w <- get-    (res, es) <- lift . Q.mapSingleMaybeDyn cIds i q $ entities w+    (res, es) <- lift . Q.mapSingleMaybeDyn cIds q $ entities w     put w {entities = es}     return res-  filterMapDyn i cIds f q = AccessT $ do+  filterMapDyn cIds f q = AccessT $ do     !w <- get-    (as, es) <- lift . Q.filterMapDyn cIds i f q $ entities w+    (as, es) <- lift . Q.filterMapDyn cIds f q $ entities w     put w {entities = es}     return as
src/Aztecs/ECS/Query.hs view
@@ -38,10 +38,10 @@   ( -- * Queries     Query,     QueryT (..),-    ArrowQueryReader (..),-    ArrowQuery (..),-    ArrowDynamicQueryReader (..),-    ArrowDynamicQuery (..),+    QueryReaderF (..),+    QueryF (..),+    DynamicQueryReaderF (..),+    DynamicQueryF (..),      -- ** Running     all,@@ -57,6 +57,7 @@     -- ** Conversion     fromReader,     toReader,+    fromDyn,      -- * Filters     QueryFilter (..),@@ -72,135 +73,141 @@ import Aztecs.ECS.Component import Aztecs.ECS.Query.Class import Aztecs.ECS.Query.Dynamic-import Aztecs.ECS.Query.Reader (QueryFilter (..), QueryReaderT (..), with, without)+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.Arrow 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.9-type Query i = QueryT Identity i+-- | @since 0.10+type Query = QueryT Identity  -- | Query for matching entities. ----- @since 0.9-newtype QueryT m i o = Query+-- @since 0.10+newtype QueryT f a = Query   { -- | Run a query, producing a `DynamicQueryT`.     ---    -- @since 0.9-    runQuery :: Components -> (ReadsWrites, Components, DynamicQueryT m i o)+    -- @since 0.10+    runQuery :: Components -> (ReadsWrites, Components, DynamicQueryT f a)   }   deriving (Functor) --- | @since 0.9-instance (Monad m) => Applicative (QueryT m i) where+-- | @since 0.10+instance (Applicative f) => Applicative (QueryT f) where   {-# INLINE pure #-}   pure a = Query (mempty,,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.9-instance (Monad m) => Category (QueryT m) where-  {-# INLINE id #-}-  id = Query (mempty,,id)-  {-# 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.9-instance (Monad m) => Arrow (QueryT m) where-  {-# INLINE arr #-}-  arr f = Query (mempty,,arr f)-  {-# INLINE first #-}-  first (Query f) = Query $ \cs -> let !(cIds, cs', qS) = f cs in (cIds, cs', first qS)---- |  @since 0.9-instance (Monad m) => ArrowChoice (QueryT m) where-  {-# INLINE left #-}-  left (Query f) = Query $ \cs -> let !(cIds, cs', qS) = f cs in (cIds, cs', left qS)---- | @since 0.9-instance (Monad m) => ArrowQueryReader (QueryT m) where+-- | @since 0.10+instance (Applicative f) => QueryReaderF (QueryT f) where   {-# INLINE fetch #-}   fetch = fromReader fetch+   {-# INLINE fetchMaybe #-}   fetchMaybe = fromReader fetchMaybe --- | @since 0.9-instance (Monad m) => ArrowDynamicQueryReader (QueryT m) where+-- | @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 --- | @since 0.9-instance (Monad m) => ArrowDynamicQuery m (QueryT m) where+-- | @since 0.10+instance (Applicative f) => DynamicQueryF f (QueryT f) where   {-# INLINE adjustDyn #-}-  adjustDyn f cId = Query (ReadsWrites Set.empty (Set.singleton cId),,adjustDyn f cId)+  adjustDyn f = fromDynInternal $ adjustDyn f+   {-# INLINE adjustDyn_ #-}-  adjustDyn_ f cId = Query (ReadsWrites Set.empty (Set.singleton cId),,adjustDyn_ f cId)+  adjustDyn_ f = fromDynInternal $ adjustDyn_ f+   {-# INLINE adjustDynM #-}-  adjustDynM f cId = Query (ReadsWrites Set.empty (Set.singleton cId),,adjustDynM f cId)+  adjustDynM f = fromDynInternal $ adjustDynM f+   {-# INLINE setDyn #-}-  setDyn cId = Query (ReadsWrites Set.empty (Set.singleton cId),,setDyn cId)+  setDyn = fromDynInternal setDyn  -- | @since 0.9-instance (Monad m) => ArrowQuery m (QueryT m) where+instance (Monad m) => QueryF m (QueryT m) where   {-# INLINE adjust #-}-  adjust :: forall i a. (Component a) => (i -> a -> a) -> QueryT m i a-  adjust f = fromDyn @a $ adjustDyn f+  adjust :: forall a b. (Component a) => (b -> a -> a) -> QueryT m b -> QueryT m a+  adjust f = fromWriterInternal @a $ adjustDyn f    {-# INLINE adjust_ #-}-  adjust_ :: forall i a. (Component a) => (i -> a -> a) -> QueryT m i ()-  adjust_ f = fromDyn @a $ adjustDyn_ f+  adjust_ :: forall a b. (Component a) => (b -> a -> a) -> QueryT m b -> QueryT m ()+  adjust_ f = fromWriterInternal @a $ adjustDyn_ f    {-# INLINE adjustM #-}-  adjustM :: forall i a. (Component a, Monad m) => (i -> a -> m a) -> QueryT m i a-  adjustM f = fromDyn @a $ adjustDynM f+  adjustM :: forall a b. (Component a, Monad m) => (b -> a -> m a) -> QueryT m b -> QueryT m a+  adjustM f = fromWriterInternal @a $ adjustDynM f    {-# INLINE set #-}-  set :: forall a. (Component a) => QueryT m a a-  set = fromDyn @a $ setDyn---- | Convert a `DynamicQueryT` to a `Query`.------ @since 0.9-{-# INLINE fromDyn #-}-fromDyn :: forall a m i o. (Component a) => (ComponentID -> DynamicQueryT m i o) -> QueryT m i o-fromDyn f = Query $ \cs ->-  let !(cId, cs') = CS.insert @a cs in (ReadsWrites (Set.singleton cId) (Set.singleton cId), cs', f cId)+  set :: forall a. (Component a) => QueryT m a -> QueryT m a+  set = fromWriterInternal @a setDyn  -- | Convert a `QueryReader` to a `Query`. -- -- @since 0.9 {-# INLINE fromReader #-}-fromReader :: (Monad m) => QueryReaderT m i o -> QueryT m i o+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)  -- | Convert a `Query` to a `QueryReader`. ----- @since 0.9+-- @since 0.10 {-# INLINE toReader #-}-toReader :: (Functor m) => QueryT m i o -> QueryReaderT m i o+toReader :: Query a -> QueryReader a toReader (Query f) = QueryReader $ \cs ->   let !(rws, cs', dynQ) = f cs in (reads rws, cs', toDynReader dynQ) +-- | Convert a `DynamicQueryT` to a `QueryT`.+--+-- @since 0.10+{-# INLINE fromDyn #-}+fromDyn :: ReadsWrites -> DynamicQueryT f a -> QueryT f a+fromDyn rws q = Query (rws,,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)++{-# INLINE fromWriterInternal #-}+fromWriterInternal ::+  forall c f a b.+  (Applicative f, 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)+ -- | Reads and writes of a `Query`. -- -- @since 0.9@@ -235,75 +242,75 @@  -- | Match all entities. ----- @since 0.9+-- @since 0.10 {-# INLINE all #-}-all :: (Monad m) => i -> QueryT m i a -> Entities -> (m [a], Entities)-all i = QR.all i . toReader+all :: Query a -> Entities -> ([a], Entities)+all = QR.all . toReader  -- | Match all entities. ----- @since 0.9+-- @since 0.10 {-# INLINE all' #-}-all' :: (Monad m) => i -> QueryT m i a -> Entities -> (m [a], Components)-all' i = QR.all' i . toReader+all' :: Query a -> Entities -> ([a], Components)+all' = QR.all' . toReader  -- | Match a single entity. ----- @since 0.9+-- @since 0.10 {-# INLINE single #-}-single :: (HasCallStack) => i -> Query i a -> Entities -> (a, Entities)-single i = QR.single i . toReader+single :: (HasCallStack) => Query a -> Entities -> (a, Entities)+single = QR.single . toReader  -- | Match a single entity. ----- @since 0.9+-- @since 0.10 {-# INLINE single' #-}-single' :: (HasCallStack) => i -> Query i a -> Entities -> (a, Components)-single' i = QR.single' i . toReader+single' :: (HasCallStack) => Query a -> Entities -> (a, Components)+single' = QR.single' . toReader  -- | Match a single entity, or `Nothing`. ----- @since 0.9+-- @since 0.10 {-# INLINE singleMaybe #-}-singleMaybe :: i -> Query i a -> Entities -> (Maybe a, Entities)-singleMaybe i = QR.singleMaybe i . toReader+singleMaybe :: Query a -> Entities -> (Maybe a, Entities)+singleMaybe = QR.singleMaybe . toReader  -- | Match a single entity, or `Nothing`. ----- @since 0.9+-- @since 0.10 {-# INLINE singleMaybe' #-}-singleMaybe' :: i -> Query i a -> Entities -> (Maybe a, Components)-singleMaybe' i = QR.singleMaybe' i . toReader+singleMaybe' :: Query a -> Entities -> (Maybe a, Components)+singleMaybe' = QR.singleMaybe' . toReader  -- | Map all matched entities. ----- @since 0.9+-- @since 0.10 {-# INLINE map #-}-map :: (Monad m) => i -> QueryT m i o -> Entities -> m ([o], Entities)-map i q es = do+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 i dynQ es+  (as, es') <- mapDyn cIds dynQ es   return (as, es' {components = cs'})  -- | Map a single matched entity. ----- @since 0.9+-- @since 0.10 {-# INLINE mapSingle #-}-mapSingle :: (HasCallStack, Monad m) => i -> QueryT m i a -> Entities -> m (a, Entities)-mapSingle i q es = do+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 i dynQ es+  (as, es') <- mapSingleDyn cIds dynQ es   return (as, es' {components = cs'})  -- | Map a single matched entity, or `Nothing`. ----- @since 0.9+-- @since 0.10 {-# INLINE mapSingleMaybe #-}-mapSingleMaybe :: (Monad m) => i -> QueryT m i a -> Entities -> m (Maybe a, Entities)-mapSingleMaybe i q es = do+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 i dynQ es+  (as, es') <- mapSingleMaybeDyn cIds dynQ es   return (as, es' {components = cs'})
src/Aztecs/ECS/Query/Class.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}  -- | -- Module      : Aztecs.ECS.Query.Reader.Class@@ -11,33 +10,32 @@ -- Maintainer  : matt@hunzinger.me -- Stability   : provisional -- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Class (ArrowQuery (..)) where+module Aztecs.ECS.Query.Class (QueryF (..)) where  import Aztecs.ECS.Component-import Aztecs.ECS.Query.Reader.Class (ArrowQueryReader)-import Control.Arrow+import Control.Monad --- | Arrow for queries that can update entities.+-- | Query functor. ----- @since 0.9-class (ArrowQueryReader arr) => ArrowQuery m arr | arr -> m where+-- @since 0.10+class (Applicative g, Functor f) => QueryF g f | f -> g where   -- | Adjust a `Component` by its type.   ---  -- @since 0.9-  adjust :: (Component a) => (i -> a -> a) -> arr i a+  -- @since 0.10+  adjust :: (Component a) => (b -> a -> a) -> f b -> f a    -- | Adjust a `Component` by its type, ignoring any output.   ---  -- @since 0.9-  adjust_ :: (Component a) => (i -> a -> a) -> arr i ()-  adjust_ f = adjust @m f >>> arr (const ())+  -- @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.9-  adjustM :: (Component a) => (i -> a -> m a) -> arr i a+  -- @since 0.10+  adjustM :: (Component a) => (b -> a -> g a) -> f b -> f a    -- | Set a `Component` by its type.   ---  -- @since 0.9-  set :: (Component a) => arr a a+  -- @since 0.10+  set :: (Component a) => f a -> f a
src/Aztecs/ECS/Query/Dynamic.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-}@@ -16,8 +17,8 @@   ( -- * Dynamic queries     DynamicQuery,     DynamicQueryT (..),-    ArrowDynamicQueryReader (..),-    ArrowDynamicQuery (..),+    DynamicQueryReaderF (..),+    DynamicQueryF (..),      -- ** Conversion     fromDynReader,@@ -39,137 +40,119 @@ import Aztecs.ECS.Query.Dynamic.Reader import Aztecs.ECS.World.Archetype (Archetype) import qualified Aztecs.ECS.World.Archetype as A-import Aztecs.ECS.World.Archetypes (Node (..))+import Aztecs.ECS.World.Archetypes (ArchetypeID, Node (..)) import qualified Aztecs.ECS.World.Archetypes as AS import Aztecs.ECS.World.Entities (Entities (..))-import Control.Arrow-import Control.Category import Control.Monad.Identity-import Data.Either (partitionEithers) import Data.Foldable+import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set-import GHC.Stack (HasCallStack)-import Prelude hiding ((.))+import GHC.Stack --- | @since 0.9 type DynamicQuery = DynamicQueryT Identity  -- | Dynamic query for components by ID. ----- @since 0.9-newtype DynamicQueryT m i o+-- @since 0.10+newtype DynamicQueryT f a   = DynamicQuery-  { -- | Run a dynamic query with a list of inputs with length equal to the number of entities in the `Archetype`.-    -- This is an internal function that should typically not be used directly.+  { -- | Run a dynamic query.     ---    -- @since 0.9-    runDynQuery :: [i] -> Archetype -> m ([o], Archetype)+    -- @since 0.10+    runDynQuery :: Archetype -> f ([a], Archetype)   }   deriving (Functor) --- | @since 0.9-instance (Monad m) => Applicative (DynamicQueryT m i) where+-- | @since 0.10+instance (Applicative f) => Applicative (DynamicQueryT f) where   {-# INLINE pure #-}-  pure a = DynamicQuery $ \is arch -> pure (replicate (length is) a, arch)-  {-# INLINE (<*>) #-}-  f <*> g = DynamicQuery $ \i arch -> do-    (as, arch') <- runDynQuery g i arch-    (fs, arch'') <- runDynQuery f i arch'-    return (zipWith ($) fs as, arch'')---- | @since 0.9-instance (Monad m) => Category (DynamicQueryT m) where-  {-# INLINE id #-}-  id = DynamicQuery $ curry pure-  {-# INLINE (.) #-}-  f . g = DynamicQuery $ \i arch -> do-    (as, arch') <- runDynQuery g i arch-    runDynQuery f as arch'---- | @since 0.9-instance (Monad m) => Arrow (DynamicQueryT m) where-  {-# INLINE arr #-}-  arr f = DynamicQuery $ \bs arch -> pure (fmap f bs, arch)-  {-# INLINE first #-}-  first f = DynamicQuery $ \bds arch -> do-    let !(bs, ds) = unzip bds-    (cs, arch') <- runDynQuery f bs arch-    return (zip cs ds, arch')+  pure a = DynamicQuery $ \arch -> pure (replicate (length $ A.entities arch) a, arch) --- | @since 0.9-instance (Monad m) => ArrowChoice (DynamicQueryT m) where-  {-# INLINE left #-}-  left f = DynamicQuery $ \eds arch -> do-    let !(es', ds) = partitionEithers eds-    (cs, arch') <- runDynQuery f es' arch-    return (fmap Left cs ++ fmap Right ds, arch')+  {-# 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'') --- | @since 0.9-instance (Monad m) => ArrowDynamicQueryReader (DynamicQueryT m) where+-- | @since 0.10+instance DynamicQueryReaderF DynamicQuery where   {-# INLINE entity #-}   entity = fromDynReader entity+   {-# INLINE fetchDyn #-}   fetchDyn = fromDynReader . fetchDyn+   {-# INLINE fetchMaybeDyn #-}   fetchMaybeDyn = fromDynReader . fetchMaybeDyn --- | @since 0.9-instance (Monad m) => ArrowDynamicQuery m (DynamicQueryT m) where+-- | @since 0.10+instance (Applicative f) => DynamicQueryF f (DynamicQueryT f) where   {-# INLINE adjustDyn #-}-  adjustDyn f cId = DynamicQuery $ \is arch -> pure $ A.zipWith is f cId arch+  adjustDyn f cId q =+    DynamicQuery (fmap (\(bs, arch') -> A.zipWith bs f cId arch') . runDynQuery q)    {-# INLINE adjustDyn_ #-}-  adjustDyn_ f cId = DynamicQuery $ \is arch -> pure (repeat (), A.zipWith_ is f cId arch)+  adjustDyn_ f cId q = DynamicQuery $ \arch ->+    fmap (\(bs, arch') -> (map (const ()) bs, A.zipWith_ bs f cId arch')) (runDynQuery q arch)    {-# INLINE adjustDynM #-}-  adjustDynM f cId = DynamicQuery $ \is arch -> A.zipWithM is f cId arch+  adjustDynM f cId q = DynamicQuery $ \arch -> do+    (bs, arch') <- runDynQuery q arch+    A.zipWithM bs f cId arch'    {-# INLINE setDyn #-}-  setDyn cId = DynamicQuery $ \is arch -> pure (is, A.insertAscList cId is arch)+  setDyn cId q =+    DynamicQuery (fmap (\(bs, arch') -> (bs, A.insertAscList cId bs arch')) . runDynQuery q)  -- | Convert a `DynamicQueryReaderT` to a `DynamicQueryT`. ----- @since 0.9+-- @since 0.10 {-# INLINE fromDynReader #-}-fromDynReader :: (Monad m) => DynamicQueryReaderT m i o -> DynamicQueryT m i o-fromDynReader q = DynamicQuery $ \is arch -> do-  !os <- runDynQueryReader' q is arch-  return (os, arch)+fromDynReader :: (Applicative m) => DynamicQueryReader a -> DynamicQueryT m a+fromDynReader q = DynamicQuery $ \arch -> let !os = runDynQueryReader q arch in pure (os, arch)  -- | Convert a `DynamicQueryT` to a `DynamicQueryReaderT`. ----- @since 0.9+-- @since 0.10 {-# INLINE toDynReader #-}-toDynReader :: (Functor m) => DynamicQueryT m i o -> DynamicQueryReaderT m i o-toDynReader q = DynamicQueryReader $ \is arch -> fst <$> runDynQuery q is arch+toDynReader :: DynamicQuery a -> DynamicQueryReader a+toDynReader q = DynamicQueryReader $ \arch -> fst $ runIdentity $ runDynQuery q arch  -- | Map all matched entities. ----- @since 0.9+-- @since 0.10 {-# INLINE mapDyn #-}-mapDyn :: (Monad m) => Set ComponentID -> i -> DynamicQueryT m i a -> Entities -> m ([a], Entities)-mapDyn cIds i q es =-  let go = runDynQuery q (repeat i)-   in if Set.null cIds-        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 !nodes = Map.insert aId n {nodeArchetype = arch'} . AS.nodes $ archetypes esAcc-                return (as' ++ acc, esAcc {archetypes = (archetypes esAcc) {AS.nodes = nodes}})-           in foldlM go' ([], es) $ Map.toList . AS.find cIds $ archetypes es+mapDyn :: (Monad m) => Set ComponentID -> DynamicQueryT m a -> Entities -> m ([a], Entities)+mapDyn cIds = mapDyn' cIds id --- | Map all matched entities.+-- | Map all matched entities with a filter. ----- @since 0.9+-- @since 0.10 {-# INLINE filterMapDyn #-}-filterMapDyn :: (Monad m) => Set ComponentID -> i -> (Node -> Bool) -> DynamicQueryT m i a -> Entities -> m ([a], Entities)-filterMapDyn cIds i f q es =-  let go = runDynQuery q (repeat i)+filterMapDyn ::+  (Monad m) =>+  Set ComponentID ->+  (Node -> Bool) ->+  DynamicQueryT m a ->+  Entities ->+  m ([a], Entities)+filterMapDyn cIds f = mapDyn' cIds (Map.filter f)++{-# 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         then do           (as, _) <- go A.empty {A.entities = Map.keysSet $ entities es}@@ -177,40 +160,41 @@         else           let go' (acc, esAcc) (aId, n) = do                 (as', arch') <- go $ nodeArchetype n-                let !nodes = Map.insert aId n {nodeArchetype = arch'} . AS.nodes $ archetypes esAcc+                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 . Map.filter f . AS.find cIds $ archetypes es+           in foldlM go' ([], es) $ Map.toList . f . AS.find cIds $ archetypes es  -- | Map a single matched entity. ----- @since 0.9-mapSingleDyn :: (HasCallStack, Monad m) => Set ComponentID -> i -> DynamicQueryT m i a -> Entities -> m (a, Entities)-mapSingleDyn cIds i q es = do-  res <- mapSingleMaybeDyn cIds i q es+-- @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   return $ case res of     (Just a, es') -> (a, es')     _ -> error "mapSingleDyn: expected single matching entity"  -- | Map a single matched entity, or @Nothing@. ----- @since 0.9+-- @since 0.10 {-# INLINE mapSingleMaybeDyn #-}-mapSingleMaybeDyn :: (Monad m) => Set ComponentID -> i -> DynamicQueryT m i a -> Entities -> m (Maybe a, Entities)-mapSingleMaybeDyn cIds i q es =+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 [i] $ A.singleton eId+        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 [i] (AS.nodeArchetype n)+        res <- runDynQuery q $ AS.nodeArchetype n         return $ case res of           ([a], arch') ->-            let nodes = Map.insert aId n {nodeArchetype = arch'} . AS.nodes $ archetypes es+            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)
src/Aztecs/ECS/Query/Dynamic/Class.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}  -- | -- Module      : Aztecs.ECS.Query.Dynamic.Class@@ -11,33 +8,32 @@ -- Maintainer  : matt@hunzinger.me -- Stability   : provisional -- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Dynamic.Class (ArrowDynamicQuery (..)) where+module Aztecs.ECS.Query.Dynamic.Class (DynamicQueryF (..)) where  import Aztecs.ECS.Component-import Aztecs.ECS.Query.Dynamic.Reader.Class-import Control.Arrow+import Control.Monad --- | Arrow dynamic query.+-- | Dynamic query functor. ----- @since 0.9-class (ArrowDynamicQueryReader arr) => ArrowDynamicQuery m arr | arr -> m where+-- @since 0.10+class (Applicative m, Functor f) => DynamicQueryF m f | f -> m where   -- | Adjust a `Component` by its `ComponentID`.   ---  -- @since 0.9-  adjustDyn :: (Component a) => (i -> a -> a) -> ComponentID -> arr i a+  -- @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.9-  adjustDyn_ :: (Component a) => (i -> a -> a) -> ComponentID -> arr i ()-  adjustDyn_ f cid = adjustDyn @m f cid >>> arr (const ())+  -- @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 `Monad` @m@.+  -- | Adjust a `Component` by its `ComponentID` with some applicative functor @g@.   ---  -- @since 0.9-  adjustDynM :: (Component a) => (i -> a -> m a) -> ComponentID -> arr i a+  -- @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.9-  setDyn :: (Component a) => ComponentID -> arr a a+  -- @since 0.10+  setDyn :: (Component a) => ComponentID -> f a -> f a
src/Aztecs/ECS/Query/Dynamic/Reader.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -13,17 +12,14 @@ -- Portability : non-portable (GHC extensions) module Aztecs.ECS.Query.Dynamic.Reader   ( -- * Dynamic queries-    DynamicQueryReader,-    DynamicQueryReaderT (..),-    ArrowDynamicQueryReader (..),+    DynamicQueryReader (..),+    DynamicQueryReaderF (..),      -- ** Running     allDyn,     filterDyn,     singleDyn,     singleMaybeDyn,-    runDynQueryReader,-    runDynQueryReaderT,      -- * Dynamic query filters     DynamicQueryFilter (..),@@ -37,80 +33,48 @@ import Aztecs.ECS.World.Archetypes (Node) import qualified Aztecs.ECS.World.Archetypes as AS import Aztecs.ECS.World.Entities (Entities (..))-import Control.Arrow-import Control.Category-import Control.Monad.Identity-import Data.Either import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import GHC.Stack --- | @since 0.9-type DynamicQueryReader = DynamicQueryReaderT Identity---- | Dynamic query for components by ID.+-- | Dynamic query reader. ----- @since 0.9-newtype DynamicQueryReaderT m i o-  = DynamicQueryReader-  { -- | Run a dynamic query with a list of inputs with length equal to the number of entities in the `Archetype`.-    -- This is an internal function that should typically not be used directly.+-- @since 0.10+newtype DynamicQueryReader a = DynamicQueryReader+  { -- | Run a dynamic query reader.     ---    -- @since 0.9-    runDynQueryReader' :: [i] -> Archetype -> m [o]+    -- @since 0.10+    runDynQueryReader :: Archetype -> [a]   }   deriving (Functor) --- | @since 0.9-instance (Monad m) => Applicative (DynamicQueryReaderT m i) where+-- | @since 0.10+instance Applicative DynamicQueryReader where   {-# INLINE pure #-}-  pure a = DynamicQueryReader $ \is _ -> pure $ replicate (length is) a-  {-# INLINE (<*>) #-}-  f <*> g =-    DynamicQueryReader $ \i arch -> do-      !as <- runDynQueryReader' g i arch-      !fs <- runDynQueryReader' f i arch-      return $ zipWith ($) fs as---- | @since 0.9-instance (Monad m) => Category (DynamicQueryReaderT m) where-  {-# INLINE id #-}-  id = DynamicQueryReader $ \as _ -> pure as-  {-# INLINE (.) #-}-  f . g = DynamicQueryReader $ \i arch -> do-    !as <- runDynQueryReader' g i arch-    runDynQueryReader' f as arch---- | @since 0.9-instance (Monad m) => Arrow (DynamicQueryReaderT m) where-  {-# INLINE arr #-}-  arr f = DynamicQueryReader $ \bs _ -> pure $ fmap f bs-  {-# INLINE first #-}-  first f = DynamicQueryReader $ \bds arch -> do-    let !(bs, ds) = unzip bds-    !cs <- runDynQueryReader' f bs arch-    return $ zip cs ds+  pure a = DynamicQueryReader $ \arch -> replicate (length $ A.entities arch) a --- | @since 0.9-instance (Monad m) => ArrowChoice (DynamicQueryReaderT m) where-  {-# INLINE left #-}-  left f = DynamicQueryReader $ \eds arch -> do-    let !(es', ds) = partitionEithers eds-    !cs <- runDynQueryReader' f es' arch-    return $ fmap Left cs ++ fmap Right ds+  {-# INLINE (<*>) #-}+  f <*> g = DynamicQueryReader $ \arch ->+    zipWith ($) (runDynQueryReader f arch) $ runDynQueryReader g arch --- | @since 0.9-instance (Monad m) => ArrowDynamicQueryReader (DynamicQueryReaderT m) where+-- | @since 0.10+instance DynamicQueryReaderF DynamicQueryReader where   {-# INLINE entity #-}-  entity = DynamicQueryReader $ \_ arch -> pure $ Set.toList $ A.entities arch+  entity = DynamicQueryReader $ \arch -> Set.toList $ A.entities arch+   {-# INLINE fetchDyn #-}-  fetchDyn cId = DynamicQueryReader $ \_ arch -> pure $ A.lookupComponentsAsc cId arch+  fetchDyn cId = DynamicQueryReader $ \arch -> A.lookupComponentsAsc cId arch+   {-# INLINE fetchMaybeDyn #-}-  fetchMaybeDyn cId = DynamicQueryReader $ \is arch -> pure $ case A.lookupComponentsAscMaybe cId arch of+  fetchMaybeDyn cId = DynamicQueryReader $ \arch -> case A.lookupComponentsAscMaybe cId arch of     Just as -> fmap Just as-    Nothing -> map (const Nothing) is+    Nothing -> replicate (length $ A.entities arch) Nothing +-- | Dynamic query for components by ID.+--+-- @since 0.9+ -- | Dynamic query filter. -- -- @since 0.9@@ -134,63 +98,49 @@ instance Monoid DynamicQueryFilter where   mempty = DynamicQueryFilter mempty mempty --- | Run a dynamic query.------ @since 0.9-{-# INLINE runDynQueryReaderT #-}-runDynQueryReaderT :: i -> DynamicQueryReaderT m i o -> Archetype -> m [o]-runDynQueryReaderT i q arch = runDynQueryReader' q (replicate (length $ A.entities arch) i) arch---- | Run a dynamic query.------ @since 0.9-{-# INLINE runDynQueryReader #-}-runDynQueryReader :: i -> DynamicQueryReader i o -> Archetype -> [o]-runDynQueryReader i q arch = runIdentity $ runDynQueryReaderT i q arch- -- | Match all entities. ----- @since 0.9-allDyn :: (Monad m) => Set ComponentID -> i -> DynamicQueryReaderT m i a -> Entities -> m [a]-allDyn cIds i q es =+-- @since 0.10+allDyn :: Set ComponentID -> DynamicQueryReader a -> Entities -> [a]+allDyn cIds q es =   if Set.null cIds-    then runDynQueryReaderT i q A.empty {A.entities = Map.keysSet $ entities es}+    then runDynQueryReader q A.empty {A.entities = Map.keysSet $ entities es}     else-      let go n = runDynQueryReaderT i q $ AS.nodeArchetype n-       in concat <$> mapM go (AS.find cIds $ archetypes es)+      let go n = runDynQueryReader q $ AS.nodeArchetype n+       in concatMap go (AS.find cIds $ archetypes es)  -- | Match all entities with a filter. ----- @since 0.9-filterDyn :: (Monad m) => Set ComponentID -> i -> (Node -> Bool) -> DynamicQueryReaderT m i a -> Entities -> m [a]-filterDyn cIds i f q es =+-- @since 0.10+filterDyn :: Set ComponentID -> (Node -> Bool) -> DynamicQueryReader a -> Entities -> [a]+filterDyn cIds f q es =   if Set.null cIds-    then runDynQueryReaderT i q A.empty {A.entities = Map.keysSet $ entities es}+    then runDynQueryReader q A.empty {A.entities = Map.keysSet $ entities es}     else-      let go n = runDynQueryReaderT i q $ AS.nodeArchetype n-       in concat <$> mapM go (Map.filter f $ AS.find cIds $ archetypes es)+      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.9-singleDyn :: (HasCallStack) => Set ComponentID -> i -> DynamicQueryReader i a -> Entities -> a-singleDyn cIds i q es = case singleMaybeDyn cIds i q es of+-- @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.9-singleMaybeDyn :: Set ComponentID -> i -> DynamicQueryReader i a -> Entities -> Maybe a-singleMaybeDyn cIds i q es =+-- @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 i q $ A.singleton eId 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 i q $ AS.nodeArchetype n of+      [n] -> case runDynQueryReader q $ AS.nodeArchetype n of         [a] -> Just a         _ -> Nothing       _ -> Nothing
src/Aztecs/ECS/Query/Dynamic/Reader/Class.hs view
@@ -6,28 +6,27 @@ -- Maintainer  : matt@hunzinger.me -- Stability   : provisional -- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Dynamic.Reader.Class (ArrowDynamicQueryReader (..)) where+module Aztecs.ECS.Query.Dynamic.Reader.Class (DynamicQueryReaderF (..)) where  import Aztecs.ECS.Component import Aztecs.ECS.Entity-import Control.Arrow --- | Arrow dynamic query reader.+-- | Dynamic query reader functor. ----- @since 0.9-class (Arrow arr) => ArrowDynamicQueryReader arr where+-- @since 0.10+class (Functor f) => DynamicQueryReaderF f where   -- | Fetch the currently matched `EntityID`.   ---  -- @since 0.9-  entity :: arr () EntityID+  -- @since 0.10+  entity :: f EntityID    -- | Fetch a `Component` by its `ComponentID`.   ---  -- @since 0.9-  fetchDyn :: (Component a) => ComponentID -> arr () a+  -- @since 0.10+  fetchDyn :: (Component a) => ComponentID -> f a    -- | Try to fetch a `Component` by its `ComponentID`.   ---  -- @since 0.9-  fetchMaybeDyn :: (Component a) => ComponentID -> arr () (Maybe a)-  fetchMaybeDyn cId = fetchDyn cId >>> arr Just+  -- @since 0.10+  fetchMaybeDyn :: (Component a) => ComponentID -> f (Maybe a)+  fetchMaybeDyn cId = Just <$> fetchDyn cId
src/Aztecs/ECS/Query/Reader.hs view
@@ -19,10 +19,9 @@ -- Portability : non-portable (GHC extensions) module Aztecs.ECS.Query.Reader   ( -- * Queries-    QueryReader,-    QueryReaderT (..),-    ArrowQueryReader (..),-    ArrowDynamicQueryReader (..),+    QueryReader (..),+    QueryReaderF (..),+    DynamicQueryReaderF (..),      -- ** Running     all,@@ -47,75 +46,49 @@ import qualified Aztecs.ECS.World.Components as CS import Aztecs.ECS.World.Entities (Entities (..)) import qualified Aztecs.ECS.World.Entities as E-import Control.Arrow-import Control.Category import Control.Monad.Identity import Data.Set (Set) import qualified Data.Set as Set import GHC.Stack-import Prelude hiding (all, id, (.))---- | @since 0.9-type QueryReader = QueryReaderT Identity+import Prelude hiding (all)  -- | Query to read from entities. ----- @since 0.9-newtype QueryReaderT m i o+-- @since 0.10+newtype QueryReader a   = QueryReader   { -- | Run a query reader.     ---    -- @since 0.9-    runQueryReader :: Components -> (Set ComponentID, Components, DynamicQueryReaderT m i o)+    -- @since 0.10+    runQueryReader :: Components -> (Set ComponentID, Components, DynamicQueryReader a)   }   deriving (Functor) --- | @since 0.9-instance (Monad m) => Applicative (QueryReaderT m i) where-  {-# INLINE pure #-}+-- | @since 0.10+instance Applicative QueryReader where   pure a = QueryReader (mempty,,pure a)-  {-# INLINE (<*>) #-}+  {-# 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)---- | @since 0.9-instance (Monad m) => Category (QueryReaderT m) where-  {-# INLINE id #-}-  id = QueryReader (mempty,,id)-  {-# INLINE (.) #-}-  (QueryReader f) . (QueryReader g) = QueryReader $ \cs ->-    let !(cIdsG, cs', aQS) = g cs-        !(cIdsF, cs'', bQS) = f cs'-     in (cIdsG <> cIdsF, cs'', bQS . aQS)---- | @since 0.9-instance (Monad m) => Arrow (QueryReaderT m) where-  {-# INLINE arr #-}-  arr f = QueryReader (mempty,,arr f)-  {-# INLINE first #-}-  first (QueryReader f) = QueryReader $ \cs -> let !(cIds, comps', qS) = f cs in (cIds, comps', first qS)---- | @since 0.9-instance (Monad m) => ArrowChoice (QueryReaderT m) where-  {-# INLINE left #-}-  left (QueryReader f) = QueryReader $ \cs -> let !(cIds, comps', qS) = f cs in (cIds, comps', left qS)+  {-# INLINE (<*>) #-} --- | @since 0.9-instance (Monad m) => ArrowQueryReader (QueryReaderT m) where-  {-# INLINE fetch #-}-  fetch :: forall a. (Component a) => QueryReaderT m () a+-- | @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 #-} -  {-# INLINE fetchMaybe #-}-  fetchMaybe :: forall a. (Component a) => QueryReaderT m () (Maybe a)+  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.9-instance (Monad m) => ArrowDynamicQueryReader (QueryReaderT m) where+-- | @since 0.10+instance DynamicQueryReaderF QueryReader where   {-# INLINE entity #-}   entity = QueryReader (mempty,,entity)   {-# INLINE fetchDyn #-}@@ -161,42 +134,42 @@  -- | Match all entities. ----- @since 0.9+-- @since 0.10 {-# INLINE all #-}-all :: (Monad m) => i -> QueryReaderT m i a -> Entities -> (m [a], Entities)-all i q es = let !(as, cs) = all' i q es in (as, es {E.components = cs})+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.9+-- @since 0.10 {-# INLINE all' #-}-all' :: (Monad m) => i -> QueryReaderT m i a -> Entities -> (m [a], Components)-all' i q es = let !(rs, cs', dynQ) = runQueryReader q (E.components es) in (allDyn rs i dynQ es, cs')+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.9+-- @since 0.10 {-# INLINE single #-}-single :: (HasCallStack) => i -> QueryReader i a -> Entities -> (a, Entities)-single i q es = let !(a, cs) = single' i q es in (a, es {E.components = cs})+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.9+-- @since 0.10 {-# INLINE single' #-}-single' :: (HasCallStack) => i -> QueryReader i a -> Entities -> (a, Components)-single' i q es = let !(rs, cs', dynQ) = runQueryReader q (E.components es) in (singleDyn rs i dynQ es, cs')+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.9+-- @since 0.10 {-# INLINE singleMaybe #-}-singleMaybe :: i -> QueryReader i a -> Entities -> (Maybe a, Entities)-singleMaybe i q es = let !(a, cs) = singleMaybe' i q es in (a, es {E.components = cs})+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.9+-- @since 0.10 {-# INLINE singleMaybe' #-}-singleMaybe' :: i -> QueryReader i a -> Entities -> (Maybe a, Components)-singleMaybe' i q es = let !(rs, cs', dynQ) = runQueryReader q (E.components es) in (singleMaybeDyn rs i dynQ es, cs')+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 view
@@ -6,22 +6,21 @@ -- Maintainer  : matt@hunzinger.me -- Stability   : provisional -- Portability : non-portable (GHC extensions)-module Aztecs.ECS.Query.Reader.Class (ArrowQueryReader (..)) where+module Aztecs.ECS.Query.Reader.Class (QueryReaderF (..)) where  import Aztecs.ECS.Component-import Control.Arrow --- | Arrow for queries that can read from entities.+-- | Query reader functor. ----- @since 0.9-class (Arrow arr) => ArrowQueryReader arr where+-- @since 0.10+class (Functor f) => QueryReaderF f where   -- | Fetch a `Component` by its type.   ---  -- @since 0.9-  fetch :: (Component a) => arr () a+  -- @since 0.10+  fetch :: (Component a) => f a    -- | Fetch a `Component` by its type, returning `Nothing` if it doesn't exist.   ---  -- @since 0.9-  fetchMaybe :: (Component a) => arr () (Maybe a)-  fetchMaybe = fetch >>> arr Just+  -- @since 0.10+  fetchMaybe :: (Component a) => f (Maybe a)+  fetchMaybe = Just <$> fetch
src/Aztecs/ECS/System.hs view
@@ -28,7 +28,7 @@ import Aztecs.ECS.Query import qualified Aztecs.ECS.Query as Q import Aztecs.ECS.Query.Dynamic (DynamicQueryT)-import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReaderT, runDynQueryReaderT)+import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReader (..)) import Aztecs.ECS.Query.Reader import Aztecs.ECS.System.Class import Aztecs.ECS.System.Dynamic.Class@@ -59,43 +59,43 @@     -- @since 0.9     runSystemT :: ReaderT (TVar Entities) m a   }-  deriving (Functor, Applicative, Monad, MonadFix)+  deriving (Functor, Applicative, Monad)  -- | @since 0.9 instance MonadDynamicSystem (DynamicQueryT STM) System where-  mapDyn i cIds q = SystemT $ do+  mapDyn cIds q = SystemT $ do     wVar <- ask     w <- lift $ readTVar wVar     let !v = V.view cIds $ archetypes w-    (o, v') <- lift $ V.mapDyn i q v+    (o, v') <- lift $ V.mapDyn q v     lift . modifyTVar wVar $ V.unview v'     return o-  mapSingleMaybeDyn i cIds q = SystemT $ do+  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 i q v+        (o, v') <- lift $ V.mapSingleDyn q v         lift . modifyTVar wVar $ V.unview v'         return o       Nothing -> return Nothing-  filterMapDyn i cIds f q = SystemT $ do+  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 i q v+    (o, v') <- lift $ V.mapDyn q v     lift . modifyTVar wVar $ V.unview v'     return o  -- | @since 0.9 instance MonadSystem (QueryT STM) System where-  map i q = SystemT $ do+  map q = SystemT $ do     (rws, dynQ) <- runSystemT $ fromQuery q-    runSystemT $ mapDyn i (Q.reads rws <> Q.writes rws) dynQ-  mapSingleMaybe i q = SystemT $ do+    runSystemT $ mapDyn (Q.reads rws <> Q.writes rws) dynQ+  mapSingleMaybe q = SystemT $ do     (rws, dynQ) <- runSystemT $ fromQuery q-    runSystemT $ mapSingleMaybeDyn i (Q.reads rws <> Q.writes rws) dynQ-  filterMap i q qf = SystemT $ do+    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@@ -105,14 +105,14 @@     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 i (Q.reads rws <> Q.writes rws) f' dynQ+    runSystemT $ filterMapDyn (Q.reads rws <> Q.writes rws) f' dynQ  -- | @since 0.9-instance MonadReaderSystem (QueryReaderT STM) System where-  all i q = SystemT $ do+instance MonadReaderSystem QueryReader System where+  all q = SystemT $ do     (cIds, dynQ) <- runSystemT $ fromQueryReader q-    runSystemT $ allDyn i cIds dynQ-  filter i q qf = SystemT $ do+    runSystemT $ allDyn cIds dynQ+  filter q qf = SystemT $ do     wVar <- ask     let go w =           let (cIds, cs', dynQ) = runQueryReader q $ components w@@ -122,28 +122,28 @@     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 i cIds dynQ f'+    runSystemT $ filterDyn cIds dynQ f'  -- | @since 0.9-instance MonadDynamicReaderSystem (DynamicQueryReaderT STM) System where-  allDyn i cIds q = SystemT $ do+instance MonadDynamicReaderSystem DynamicQueryReader System where+  allDyn cIds q = SystemT $ do     wVar <- ask     w <- lift $ readTVar wVar     let !v = V.view cIds $ archetypes w-    lift $+    return $       if V.null v-        then runDynQueryReaderT i q A.empty {A.entities = Map.keysSet $ entities w}-        else V.allDyn i q v-  filterDyn i cIds q f = SystemT $ do+        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-    lift $ V.allDyn i q v+    return $ V.allDyn q v  -- | Convert a `QueryReaderT` to a `System`. -- -- @since 0.9-fromQueryReader :: QueryReaderT STM i o -> System (Set ComponentID, DynamicQueryReaderT STM i o)+fromQueryReader :: QueryReader a -> System (Set ComponentID, DynamicQueryReader a) fromQueryReader q = SystemT $ do   wVar <- ask   let go w =@@ -154,7 +154,7 @@ -- | Convert a `QueryT` to a `System`. -- -- @since 0.9-fromQuery :: QueryT STM i o -> System (ReadsWrites, DynamicQueryT STM i o)+fromQuery :: QueryT STM a -> System (ReadsWrites, DynamicQueryT STM a) fromQuery q = SystemT $ do   wVar <- ask   let go w =
src/Aztecs/ECS/System/Class.hs view
@@ -21,19 +21,19 @@   -- | Map all matching entities with a query.   --   -- @since 0.9-  map :: i -> q i o -> m [o]+  map :: q a -> m [a]    -- | Map a single matching entity with a query, or @Nothing@.   --   -- @since 0.9-  mapSingleMaybe :: i -> q i o -> m (Maybe o)+  mapSingleMaybe :: q a -> m (Maybe a)    -- | Map a single matching entity with a query.   --   -- @since 0.9-  mapSingle :: (HasCallStack) => i -> q i o -> m o-  mapSingle i q = do-    res <- mapSingleMaybe i q+  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."@@ -41,4 +41,4 @@   -- | Map all matching entities with a query and filter.   --   -- @since 0.9-  filterMap :: i -> q i o -> QueryFilter -> m [o]+  filterMap :: q a -> QueryFilter -> m [a]
src/Aztecs/ECS/System/Dynamic/Class.hs view
@@ -22,17 +22,17 @@   -- | Map all matching entities with a query.   --   -- @since 0.9-  mapDyn :: i -> Set ComponentID -> q i o -> m [o]+  mapDyn :: Set ComponentID -> q a -> m [a]    -- | Map a single matching entity with a query, or @Nothing@.   --   -- @since 0.9-  mapSingleMaybeDyn :: i -> Set ComponentID -> q i a -> m (Maybe a)+  mapSingleMaybeDyn :: Set ComponentID -> q a -> m (Maybe a)    -- | Map a single matching entity with a query.-  mapSingleDyn :: (HasCallStack) => i -> Set ComponentID -> q i o -> m o-  mapSingleDyn i cIds q = do-    res <- mapSingleMaybeDyn i cIds q+  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."@@ -40,4 +40,4 @@   -- | Map all matching entities with a query and filter.   --   -- @since 0.9-  filterMapDyn :: i -> Set ComponentID -> (Node -> Bool) -> q i a -> m [a]+  filterMapDyn :: Set ComponentID -> (Node -> Bool) -> q a -> m [a]
src/Aztecs/ECS/System/Dynamic/Reader/Class.hs view
@@ -22,14 +22,14 @@   -- | Match all entities with a query.   --   -- @since 0.9-  allDyn :: i -> Set ComponentID -> q i o -> m [o]+  allDyn :: Set ComponentID -> q a -> m [a]    -- | Match a single entity with a query.   --   -- @since 0.9-  singleDyn :: (HasCallStack) => i -> Set ComponentID -> q i o -> m o-  singleDyn i cIds q = do-    os <- allDyn i cIds q+  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"@@ -37,9 +37,9 @@   -- | Match a single entity with a query, or Nothing.   --   -- @since 0.9-  singleMaybeDyn :: i -> Set ComponentID -> q i o -> m (Maybe o)-  singleMaybeDyn i cIds q = do-    os <- allDyn i cIds q+  singleMaybeDyn :: Set ComponentID -> q a -> m (Maybe a)+  singleMaybeDyn cIds q = do+    os <- allDyn cIds q     return $ case os of       [o] -> Just o       _ -> Nothing@@ -47,4 +47,4 @@   -- | Match all entities with a query and filter.   --   -- @since 0.9-  filterDyn :: i -> Set ComponentID -> q i a -> (Node -> Bool) -> m [a]+  filterDyn :: Set ComponentID -> q a -> (Node -> Bool) -> m [a]
src/Aztecs/ECS/System/Reader/Class.hs view
@@ -21,14 +21,14 @@   -- | Match all entities with a query.   --   -- @since 0.9-  all :: i -> q i o -> m [o]+  all :: q a -> m [a]    -- | Match a single entity with a query.   --   -- @since 0.9-  single :: (HasCallStack) => i -> q i o -> m o-  single i q = do-    os <- all i q+  single :: (HasCallStack) => q a -> m a+  single q = do+    os <- all q     case os of       [o] -> return o       _ -> error "single: expected a single result"@@ -36,9 +36,9 @@   -- | Match a single entity with a query, or @Nothing@.   --   -- @since 0.9-  singleMaybe :: i -> q i o -> m (Maybe o)-  singleMaybe i q = do-    os <- all i q+  singleMaybe :: q a -> m (Maybe a)+  singleMaybe q = do+    os <- all q     return $ case os of       [o] -> Just o       _ -> Nothing@@ -46,4 +46,4 @@   -- | Match all entities with a query and filter.   --   -- @since 0.9-  filter :: i -> q i o -> QueryFilter -> m [o]+  filter :: q a -> QueryFilter -> m [a]
src/Aztecs/ECS/View.hs view
@@ -26,7 +26,7 @@ where  import Aztecs.ECS.Query.Dynamic (DynamicQueryT (..))-import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReaderT (..), runDynQueryReaderT)+import Aztecs.ECS.Query.Dynamic.Reader (DynamicQueryReader (..)) import Aztecs.ECS.World.Archetypes import qualified Aztecs.ECS.World.Archetypes as AS import Aztecs.ECS.World.Components@@ -95,12 +95,12 @@ -- | Query all matching entities in a `View`. -- -- @since 0.9-allDyn :: (Monad m) => i -> DynamicQueryReaderT m i a -> View -> m [a]-allDyn i q v =-  foldlM-    ( \acc n -> do-        as <- runDynQueryReaderT i q $ nodeArchetype n-        return $ as ++ acc+allDyn :: DynamicQueryReader a -> View -> [a]+allDyn q v =+  foldl'+    ( \acc n ->+        let as = runDynQueryReader q $ nodeArchetype n+         in as ++ acc     )     []     (viewArchetypes v)@@ -108,22 +108,20 @@ -- | Query all matching entities in a `View`. -- -- @since 0.9-singleDyn :: (Monad m) => i -> DynamicQueryReaderT m i a -> View -> m (Maybe a)-singleDyn i q v = do-  as <- allDyn i q v-  return $ case as of-    [a] -> Just a-    _ -> Nothing+singleDyn :: DynamicQueryReader a -> View -> Maybe a+singleDyn q v = case allDyn q v of+  [a] -> Just a+  _ -> Nothing  -- | Map all matching entities in a `View`. -- -- @since 0.9-mapDyn :: (Monad m) => i -> DynamicQueryT m i a -> View -> m ([a], View)-mapDyn i q v = do+mapDyn :: (Monad m) => DynamicQueryT m a -> View -> m ([a], View)+mapDyn q v = do   (as, arches) <-     foldlM       ( \(acc, archAcc) (aId, n) -> do-          (as', arch') <- runDynQuery q (repeat i) $ nodeArchetype n+          (as', arch') <- runDynQuery q $ nodeArchetype n           return (as' ++ acc, Map.insert aId (n {nodeArchetype = arch'}) archAcc)       )       ([], Map.empty)@@ -133,9 +131,9 @@ -- | Map a single matching entity in a `View`. -- -- @since 0.9-mapSingleDyn :: (Monad m) => i -> DynamicQueryT m i a -> View -> m (Maybe a, View)-mapSingleDyn i q v = do-  (as, arches) <- mapDyn i q v+mapSingleDyn :: (Monad m) => DynamicQueryT m a -> View -> m (Maybe a, View)+mapSingleDyn q v = do+  (as, arches) <- mapDyn q v   return $ case as of     [a] -> (Just a, arches)     _ -> (Nothing, arches)
src/Aztecs/ECS/World/Archetype.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-}@@ -46,7 +47,11 @@ import Aztecs.ECS.World.Storage.Dynamic import qualified Aztecs.ECS.World.Storage.Dynamic as S import Control.DeepSeq-import Control.Monad.Writer hiding (zipWithM)+import Control.Monad.Writer+  ( MonadWriter (..),+    WriterT (..),+    runWriter,+  ) import Data.Dynamic import Data.Foldable import Data.IntMap (IntMap)@@ -75,6 +80,12 @@   }   deriving (Show, Generic, NFData) +instance Semigroup Archetype where+  a <> b = Archetype {storages = storages a <> storages b, entities = entities a <> entities b}++instance Monoid Archetype where+  mempty = empty+ -- | Empty archetype. -- -- @since 0.9@@ -165,18 +176,19 @@ -- -- @since 0.9 zipWithM ::-  forall m a c. (Monad m, Component c) => [a] -> (a -> c -> m c) -> ComponentID -> Archetype -> m ([c], Archetype)+  forall m a c. (Applicative m, Component c) => [a] -> (a -> c -> m c) -> ComponentID -> Archetype -> m ([c], Archetype) zipWithM as f cId arch = do   let go maybeDyn = case maybeDyn of         Just dyn -> case fromDynamic $ storageDyn dyn of-          Just s -> do-            (cs', s') <- lift $ S.zipWithM @c @(StorageT c) f as s-            tell cs'-            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'})+          Just s ->+            WriterT $+              fmap+                (\(cs, s') -> (Just dyn {storageDyn = toDyn s'}, cs))+                (S.zipWithM @c @(StorageT c) f as s)+          Nothing -> pure maybeDyn+        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. --@@ -185,14 +197,13 @@ zipWith_ ::   forall a c. (Component c) => [a] -> (a -> c -> c) -> ComponentID -> Archetype -> Archetype zipWith_ as f cId arch =-  let go maybeDyn = case maybeDyn of+  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 -> maybeDyn+          Nothing -> Nothing         Nothing -> Nothing-      !storages' = IntMap.alter go (unComponentId cId) $ storages arch-   in (arch {storages = storages'})+   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/Storage.hs view
@@ -47,10 +47,10 @@   -- @since 0.9   zipWith :: (i -> a -> a) -> [i] -> s -> ([a], s) -  -- | Map a monadic 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-  zipWithM :: (Monad m) => (i -> a -> m a) -> [i] -> s -> m ([a], s)+  zipWithM :: (Applicative m) => (i -> a -> m a) -> [i] -> s -> m ([a], s)    -- | Map a function with some input over all components in the storage.   --@@ -73,6 +73,4 @@   {-# INLINE zipWith_ #-}   zipWith_ = Prelude.zipWith   {-# INLINE zipWithM #-}-  zipWithM f is as = do-    as' <- Control.Monad.zipWithM f is as-    return (as', as')+  zipWithM f is as = (\as' -> (as', as')) <$> Control.Monad.zipWithM f is as
src/Aztecs/Hierarchy.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE Arrows #-}+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}@@ -36,7 +36,6 @@ import qualified Aztecs.ECS.Access as A import qualified Aztecs.ECS.Query as Q import qualified Aztecs.ECS.System as S-import Control.Arrow import Control.DeepSeq import Control.Monad import Data.Map (Map)@@ -89,32 +88,25 @@ -- -- @since 0.9 update ::-  ( ArrowQueryReader qr,-    ArrowDynamicQueryReader qr,+  ( Applicative qr,+    QueryReaderF qr,+    DynamicQueryReaderF qr,     MonadReaderSystem qr s,     MonadAccess b m   ) =>   s (m ()) update = do-  parents <--    S.all-      ()-      ( proc () -> do-          entity <- Q.entity -< ()-          Parent parent <- Q.fetch -< ()-          maybeParentState <- Q.fetchMaybe @_ @ParentState -< ()-          returnA -< (entity, parent, maybeParentState)-      )+  parents <- S.all $ do+    entity <- Q.entity+    parent <- Q.fetch+    maybeParentState <- Q.fetchMaybe @_ @ParentState+    return (entity, unParent parent, maybeParentState) -  children <--    S.all-      ()-      ( proc () -> do-          entity <- Q.entity -< ()-          Children cs <- Q.fetch -< ()-          maybeChildState <- Q.fetchMaybe @_ @ChildState -< ()-          returnA -< (entity, cs, maybeChildState)-      )+  children <- S.all $ do+    entity <- Q.entity+    cs <- Q.fetch+    maybeChildState <- Q.fetchMaybe @_ @ChildState+    return (entity, unChildren cs, maybeChildState)    let go = do         mapM_@@ -212,21 +204,17 @@ -- -- @since 0.9 hierarchy ::-  (ArrowQueryReader q, ArrowDynamicQueryReader q, MonadReaderSystem q s) =>+  (Applicative q, QueryReaderF q, DynamicQueryReaderF q, MonadReaderSystem q s) =>   EntityID ->-  i ->-  q i a ->+  q a ->   s (Maybe (Hierarchy a))-hierarchy e i q = do-  children <--    S.all-      ()-      ( proc () -> do-          entity <- Q.entity -< ()-          Children cs <- Q.fetch -< ()-          a <- q -< i-          returnA -< (entity, (cs, 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 @@ -234,23 +222,21 @@ -- -- @since 0.9 hierarchies ::-  (ArrowQueryReader q, ArrowDynamicQueryReader q, MonadReaderSystem q s) =>-  i ->-  q i a ->+  (Applicative q, QueryReaderF q, DynamicQueryReaderF q, MonadReaderSystem q s) =>+  q a ->   s [Hierarchy a]-hierarchies i q = do+hierarchies q = do   children <-     S.all-      ()-      ( proc () -> do-          entity <- Q.entity -< ()-          Children cs <- Q.fetch -< ()-          a <- q -< i-          returnA -< (entity, (cs, a))+      ( 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+  roots <- S.filter Q.entity $ with @Children <> without @Parent   return $ mapMaybe (`hierarchy'` childMap) roots  -- | Build a hierarchy of parents to children.
src/Aztecs/Transform.hs view
@@ -116,8 +116,9 @@ -- @since 0.9 update ::   forall q s b m a.-  ( ArrowQueryReader q,-    ArrowDynamicQueryReader q,+  ( Applicative q,+    QueryReaderF q,+    DynamicQueryReaderF q,     MonadReaderSystem q s,     Component a,     Monoid a,@@ -130,8 +131,9 @@ -- -- @since 0.9 update2d ::-  ( ArrowQueryReader q,-    ArrowDynamicQueryReader q,+  ( Applicative q,+    QueryReaderF q,+    DynamicQueryReaderF q,     MonadReaderSystem q s,     MonadAccess b m   ) =>@@ -142,23 +144,25 @@ -- -- @since 0.9 propagate ::-  ( ArrowQueryReader q,-    ArrowDynamicQueryReader q,+  ( Applicative q,+    QueryReaderF q,+    DynamicQueryReaderF q,     MonadReaderSystem q s,     Component a,     Monoid a   ) =>   s [Hierarchy a] propagate = do-  hs <- hierarchies () Q.fetch+  hs <- hierarchies Q.fetch   return $ map propagateHierarchy hs  -- | Propagate all hierarchies of `Transform2D` components. -- -- @since 0.9 propagate2d ::-  ( ArrowQueryReader q,-    ArrowDynamicQueryReader q,+  ( Applicative q,+    QueryReaderF q,+    DynamicQueryReaderF q,     MonadReaderSystem q s   ) =>   s [Hierarchy Transform2D]
test/Main.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE ApplicativeDo #-}-{-# LANGUAGE Arrows #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -14,7 +13,6 @@ import Aztecs.ECS.Component (ComponentID (ComponentID)) import qualified Aztecs.ECS.Query as Q import qualified Aztecs.ECS.World as W-import Control.Arrow import Control.DeepSeq import Data.Functor.Identity (Identity (runIdentity)) import Data.Word@@ -56,22 +54,21 @@ -}  prop_queryEmpty :: Expectation-prop_queryEmpty = do-  res <- fst $ Q.all () (Q.fetch @_ @X) $ W.entities W.empty-  res `shouldMatchList` []+prop_queryEmpty =+  let res = fst $ Q.all (Q.fetch @_ @X) $ W.entities W.empty in res `shouldMatchList` []  -- | Query all components from a list of `ComponentID`s. queryComponentIds ::   forall q a.-  (ArrowDynamicQueryReader q, Component a) =>+  (Applicative q, DynamicQueryReaderF q, Component a) =>   [ComponentID] ->-  q () (EntityID, [a])+  q (EntityID, [a]) queryComponentIds =-  let go cId qAcc = proc () -> do-        x' <- Q.fetchDyn @_ @a cId -< ()-        (e, xs) <- qAcc -< ()-        returnA -< (e, x' : xs)-   in foldr go (Q.entity &&& arr (const []))+  let go cId qAcc = do+        x' <- Q.fetchDyn @_ @a cId+        (e, xs) <- qAcc+        return (e, x' : xs)+   in foldr go ((,) <$> Q.entity <*> pure [])  prop_queryDyn :: [[X]] -> Expectation prop_queryDyn xs =@@ -87,20 +84,20 @@       (es, w) = foldr spawn ([], W.empty) xs       go (e, cs) = do         let q = queryComponentIds $ map snd cs-        res <- fst $ Q.all () q $ W.entities w+            (res, _) = Q.all 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 <- fst $ Q.all () Q.fetch $ W.entities w+      (res, _) = Q.all 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 <- fst $ Q.all () (Q.fetch &&& Q.fetch) $ W.entities w+      (res, _) = Q.all ((,) <$> Q.fetch <*> Q.fetch) $ W.entities w   res `shouldMatchList` xys  prop_queryThreeTypedComponents :: [(X, Y, Z)] -> Expectation@@ -111,21 +108,21 @@         y <- Q.fetch         z <- Q.fetch         pure (x, y, z)-  res <- fst $ Q.all () q $ W.entities w+      (res, _) = Q.all 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, _) = Q.single 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.fetch >>> arr (\(X x) -> X $ x + 1) >>> Q.set-      w' = foldr (\_ es -> snd . runIdentity $ Q.mapSingle () q es) (W.entities w) [1 .. n]-      (res, _) = Q.single () Q.fetch w'+      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'    in res `shouldBe` X (fromIntegral n)  {-TODO