apecs-effectful (empty) → 0.1.0.0

raw patch · 5 files changed

+308/−0 lines, 5 filesdep +apecsdep +basedep +effectful-core

Dependencies added: apecs, base, effectful-core, vector

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
README.md +5/−0
apecs-effectful.cabal +34/−0
src/Apecs/Effectful.hs +234/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for apecs-effectful
+
+## 0.1.0.0 -- 2023-05-12
+
+* Initial release.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2023, Michael Szvetits
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Michael Szvetits nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,5 @@+# apecs-effectful
+
+[![Hackage](https://img.shields.io/hackage/v/apecs-effectful.svg?logo=haskell&label=apecs-effectful)](https://hackage.haskell.org/package/apecs-effectful)
+
+`apecs-effectful` is an adaptation of the Haskell library [apecs](https://hackage.haskell.org/package/apecs) for the [effectful](https://hackage.haskell.org/package/effectful-core) ecosystem. The documentation can be found on [Hackage](https://hackage.haskell.org/package/apecs-effectful).

+ apecs-effectful.cabal view

@@ -0,0 +1,34 @@+cabal-version:   3.0
+name:            apecs-effectful
+version:         0.1.0.0
+synopsis:        Adaptation of the apecs library for the effectful ecosystem.
+description:     Please see the README on GitHub at <https://github.com/typedbyte/apecs-effectful#readme>
+homepage:        https://github.com/typedbyte/apecs-effectful
+bug-reports:     https://github.com/typedbyte/apecs-effectful/issues
+license:         BSD-3-Clause
+license-file:    LICENSE
+author:          Michael Szvetits
+maintainer:      typedbyte@qualified.name
+copyright:       2023 Michael Szvetits
+category:        Game
+build-type:      Simple
+extra-doc-files:
+  CHANGELOG.md
+  README.md
+
+common shared-properties
+  default-language: GHC2021
+  build-depends:
+      base >= 4.16.0 && < 5
+  ghc-options:
+      -Wall
+
+library
+  import: shared-properties
+  hs-source-dirs: src
+  build-depends:
+      apecs          >= 0.9.3  && < 0.10
+    , effectful-core >= 2.0    && < 2.3
+    , vector         >= 0.11.0 && < 0.14
+  exposed-modules:
+      Apecs.Effectful

+ src/Apecs/Effectful.hs view

@@ -0,0 +1,234 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE TypeFamilies        #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Apecs.Effectful
+-- Copyright   : (c) Michael Szvetits, 2023
+-- License     : BSD-3-Clause (see the file LICENSE)
+-- Maintainer  : typedbyte@qualified.name
+-- Stability   : stable
+-- Portability : portable
+--
+-- Adaptation of the apecs library for the effectful ecosystem.
+-----------------------------------------------------------------------------
+module Apecs.Effectful
+  ( -- * Effectful Adaptation
+    ECS
+  , runECS
+  , runGC
+  , Get
+  , Set
+  , Destroy
+  , Members
+  , newEntity
+  , newEntity_
+  , get
+  , tryGet
+  , set
+  , ($=)
+  , destroy
+  , exists
+  , modify
+  , ($~)
+  , cmap
+  , cmapM
+  , cmapM_
+  , cfold
+  , cfoldM
+  , cfoldM_
+    -- * Re-exports
+  , Entity(..)
+  , EntityCounter
+  , Not(..)
+  , Component(..)
+  , Has(..)
+  , Cache
+  , Global
+  , Map
+  , Unique
+  , SystemT(SystemT)
+  , makeWorld
+  , makeWorldAndComponents
+  , global
+  , explInit
+  , asks
+  ) where
+
+-- apecs
+import Apecs      qualified as Apecs
+import Apecs.Core qualified as Apecs
+import Apecs hiding
+  ( Destroy
+  , Get
+  , Members
+  , Set
+  , cfold
+  , cfoldM
+  , cfoldM_
+  , cmap
+  , cmapM
+  , cmapM_
+  , exists
+  , destroy
+  , get
+  , modify
+  , newEntity
+  , newEntity_
+  , runGC
+  , set
+  , ($=)
+  , ($~)
+  )
+
+-- base
+import Data.Kind (Type)
+
+-- effectful-core
+import Effectful                 (Eff, Dispatch(Static), DispatchOf, Effect, IOE, (:>))
+import Effectful.Dispatch.Static (SideEffects(..), StaticRep, evalStaticRep, getStaticRep, unsafeEff_)
+
+-- vector
+import Data.Vector.Unboxed qualified as U
+
+-- | Provide the ability to query and manipulate worlds of type @w@.
+data ECS (w :: Type) :: Effect
+
+type instance DispatchOf (ECS w) = Static WithSideEffects
+
+newtype instance StaticRep (ECS w) = ECS w
+
+-- | Indicates that world @w@ has writeable components of type @c@.
+type Set w c = Apecs.Set w IO c
+
+-- | Indicates that world @w@ has readable components of type @c@.
+type Get w c = Apecs.Get w IO c
+
+-- | Indicates that world @w@ has deletable components of type @c@.
+type Destroy w c = Apecs.Destroy w IO c
+
+-- | Indicates that world @w@ contains components of type @c@.
+type Members w c = Apecs.Members w IO c
+
+-- | Run the t'ECS' effect using the world initialization function provided by
+-- 'makeWorld' or 'makeWorldAndComponents'.
+runECS :: IOE :> es => IO w -> Eff (ECS w : es) a -> Eff es a
+runECS worldInit m = do
+  w <- unsafeEff_ worldInit
+  evalStaticRep (ECS w) m
+
+toEff :: ECS w :> es => System w a -> Eff es a
+toEff system = do
+  ECS w <- getStaticRep
+  unsafeEff_ $ runSystem system w
+{-# INLINE toEff #-}
+
+-- | Explicitly invoke the garbage collector.
+runGC :: forall w es. ECS w :> es => Eff es ()
+runGC = toEff @w Apecs.runGC
+{-# INLINE runGC #-}
+
+-- | Writes the given components to a new entity.
+newEntity :: forall w c es. (ECS w :> es, Set w c, Get w EntityCounter) => c -> Eff es Entity
+newEntity = toEff @w . Apecs.newEntity
+{-# INLINE newEntity #-}
+
+-- | Writes the given components to a new entity.
+newEntity_ :: forall w c es. (ECS w :> es, Set w c, Get w EntityCounter) => c -> Eff es ()
+newEntity_ = toEff @w . Apecs.newEntity_
+{-# INLINE newEntity_ #-}
+
+-- | Read a component from an entity.
+get :: forall w c es. (ECS w :> es, Get w c) => Entity -> Eff es c
+get = toEff @w . Apecs.get
+{-# INLINE get #-}
+
+-- | Read a component from an entity, if available.
+tryGet :: forall w c es. (ECS w :> es, Get w c) => Entity -> Eff es (Maybe c)
+tryGet entity = do
+  existing <- exists @c @w entity
+  if existing then do
+    c <- get @w entity
+    pure (Just c)
+  else
+    pure Nothing
+{-# INLINE tryGet #-}
+
+-- | Writes a component to a given entity.
+set :: forall w c es. (ECS w :> es, Set w c) => Entity -> c -> Eff es ()
+set entity = toEff @w . Apecs.set entity
+{-# INLINE set #-}
+
+-- | Writes a component to a given entity.
+infixr 2 $=
+($=) :: forall w c es. (ECS w :> es, Set w c) => Entity -> c -> Eff es ()
+($=) entity = toEff @w . (Apecs.$=) entity
+{-# INLINE ($=) #-}
+
+-- | Destroys component @c@ for the given entity.
+destroy :: forall c w es. (ECS w :> es, Destroy w c) => Entity -> Eff es ()
+destroy entity = toEff @w $ Apecs.destroy entity (Proxy :: Proxy c)
+{-# INLINE destroy #-}
+
+-- | Returns whether the given entity has component @c@.
+exists :: forall c w es. (ECS w :> es, Get w c) => Entity -> Eff es Bool
+exists entity = toEff @w $ Apecs.exists entity (Proxy :: Proxy c)
+{-# INLINE exists #-}
+
+-- | Read a component and writes a new component of an entity.
+modify :: forall w cx cy es. (ECS w :> es, Get w cx, Set w cy) => Entity -> (cx -> cy) -> Eff es ()
+modify entity = toEff @w . Apecs.modify entity
+{-# INLINE modify #-}
+
+-- | Read the component @cx@ and writes the component @cy@ of an entity.
+infixr 2 $~
+($~) :: forall w cx cy es. (ECS w :> es, Get w cx, Set w cy) => Entity -> (cx -> cy) -> Eff es ()
+($~) entity = toEff @w . (Apecs.$~) entity
+{-# INLINE ($~) #-}
+
+-- | Read the component @cx@ and writes the component @cy@ of all entities.
+cmap :: forall w cx cy es. (ECS w :> es, Get w cx, Members w cx, Set w cy) => (cx -> cy) -> Eff es ()
+cmap = toEff @w . Apecs.cmap
+{-# INLINE cmap #-}
+
+-- | Monadic variant of 'cmap'.
+cmapM :: forall w cx cy es. (ECS w :> es, Get w cx, Set w cy, Members w cx) => (cx -> Eff es cy) -> Eff es ()
+cmapM f = do
+  sx <- toEff @w (Apecs.getStore @w @IO @cx)
+  sy <- toEff @w (Apecs.getStore @w @IO @cy)
+  sl <- unsafeEff_ $ Apecs.explMembers sx
+  U.forM_ sl $ \e -> do
+    x <- unsafeEff_ $ Apecs.explGet sx e
+    y <- f x
+    unsafeEff_ $ Apecs.explSet sy e y
+{-# INLINE cmapM #-}
+
+-- | Monadic variant of 'cmap', ignoring the result of the applied function.
+cmapM_ :: forall w c es. (ECS w :> es, Get w c, Members w c) => (c -> Eff es ()) -> Eff es ()
+cmapM_ f = do
+  s <- toEff @w (Apecs.getStore @w @IO @c)
+  l <- unsafeEff_ $ Apecs.explMembers s
+  U.forM_ l $ \e ->
+    unsafeEff_ (Apecs.explGet s e) >>= f
+{-# INLINE cmapM_ #-}
+
+-- | Fold over the components @c@ of the game world.
+cfold :: forall w c a es. (ECS w :> es, Members w c, Get w c) => (a -> c -> a) -> a -> Eff es a
+cfold f = toEff @w . Apecs.cfold f
+{-# INLINE cfold #-}
+
+-- | Monadic variant of 'cfold'.
+cfoldM :: forall w c a es. (ECS w :> es, Members w c, Get w c) => (a -> c -> Eff es a) -> a -> Eff es a
+cfoldM f start = do
+  s <- toEff @w (Apecs.getStore @w @IO @c)
+  l <- unsafeEff_ $ Apecs.explMembers s
+  U.foldM' (\a e -> unsafeEff_ (Apecs.explGet s e) >>= f a) start l
+{-# INLINE cfoldM #-}
+
+-- | Monadic variant of 'cfold', ignoring the result.
+cfoldM_ :: forall w c a es. (ECS w :> es, Members w c, Get w c) => (a -> c -> Eff es a) -> a -> Eff es ()
+cfoldM_ f start = do
+  s <- toEff @w (Apecs.getStore @w @IO @c)
+  l <- unsafeEff_ $ Apecs.explMembers s
+  U.foldM'_ (\a e -> unsafeEff_ (Apecs.explGet s e) >>= f a) start l
+{-# INLINE cfoldM_ #-}