Added effectful

effects-benchmarks.cabal

@@ -14,6 +14,15 @@ benchmark effects-benchmarks
   type: exitcode-stdio-1.0
   main-is: Main.hs
   other-modules:
+      Effectful.Bench
+      Effectful.Dynamic.Bench
+      Effectful.Dynamic.HTTP
+      Effectful.Dynamic.Stateful
+      Effectful.Dynamic.StatefulExcept
+      Effectful.Static.Bench
+      Effectful.Static.HTTP
+      Effectful.Static.Stateful
+      Effectful.Static.StatefulExcept
       ExtEff.Bench
       ExtEff.HTTP
       ExtEff.Stateful
@@ -62,6 +71,8 @@ benchmark effects-benchmarks
       DerivingStrategies
   build-depends:
       base
+    , effectful
+    , effectful-core
     , extensible-effects
     , freer-simple
     , fused-effects

instances/Effectful/Dynamic/Bench.hs

@@ -0,0 +1,18 @@
+module Effectful.Dynamic.Bench where
+
+import Effectful
+import Effectful.Dynamic.HTTP
+import Effectful.Dynamic.Stateful
+import Effectful.Dynamic.StatefulExcept
+import Effectful.Error.Dynamic
+import Effectful.State.Dynamic
+import GHC.Stack (CallStack)
+
+countDownBench :: Int -> (Int, Int)
+countDownBench start = runPureEff . runLocalState start $ countDownPut
+
+countDownExcBench :: Int -> Either (CallStack, String) (Int, Int)
+countDownExcBench start = runPureEff . runError . runLocalState start $ countDownExc
+
+httpBench :: Int -> IO Int
+httpBench n = runEff $ runHTTP (doHTTP n)

instances/Effectful/Dynamic/HTTP.hs

@@ -0,0 +1,39 @@
+module Effectful.Dynamic.HTTP where
+
+import Control.Monad
+import Data.Kind
+import Effectful
+import Effectful.Dispatch.Static
+import Effectful.Internal.Monad
+
+data HTTP :: Effect where
+  Open :: String -> HTTP m ()
+  Close :: HTTP m ()
+  Post :: String -> HTTP m String
+  Get :: HTTP m String
+
+runHTTP :: Eff (HTTP : es) a -> Eff es a
+runHTTP = interpret $ \_ -> \case
+  Open _ -> pure ()
+  Close -> pure ()
+  Post a -> pure ("posted" <> a)
+  Get -> pure "gotten"
+
+open :: HTTP :> es => String -> Eff es ()
+open = send . Open
+
+close :: HTTP :> es => Eff es ()
+close = send Close
+
+post :: HTTP :> es => String -> Eff es String
+post = send . Post
+
+get :: HTTP :> es => Eff es String
+get = send Get
+
+doHTTP :: HTTP :> es => Int -> Eff es Int
+doHTTP n = do
+  open "cats"
+  replicateM_ n (get *> post "cats")
+  close
+  pure n

instances/Effectful/Dynamic/Stateful.hs

@@ -0,0 +1,7 @@
+module Effectful.Dynamic.Stateful where
+
+import Effectful
+import Effectful.State.Dynamic
+
+countDownPut :: State Int :> es => Eff es Int
+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)

instances/Effectful/Dynamic/StatefulExcept.hs

@@ -0,0 +1,10 @@
+module Effectful.Dynamic.StatefulExcept where
+
+import Effectful
+import Effectful.Error.Dynamic
+import Effectful.State.Dynamic
+
+countDownExc :: (State Int :> es, Error String :> es) => Eff es b
+countDownExc = go
+  where
+    go = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> go)

instances/Effectful/Static/Bench.hs

@@ -0,0 +1,17 @@
+module Effectful.Static.Bench where
+
+import Effectful
+import Effectful.Error
+import Effectful.State.Local
+import Effectful.Static.HTTP
+import Effectful.Static.Stateful
+import Effectful.Static.StatefulExcept
+
+countDownBench :: Int -> (Int, Int)
+countDownBench start = runPureEff . runState start $ countDownPut
+
+countDownExcBench :: Int -> Either (CallStack, String) (Int, Int)
+countDownExcBench start = runPureEff . runError . runState start $ countDownExc
+
+httpBench :: Int -> IO Int
+httpBench n = runEff $ runHTTP (doHTTP n)

instances/Effectful/Static/HTTP.hs

@@ -0,0 +1,30 @@
+module Effectful.Static.HTTP where
+
+import Control.Monad
+import Data.Kind
+import Effectful
+import Effectful.Dispatch.Static
+
+data HTTP (m :: Type -> Type) r = HTTP
+
+runHTTP :: Eff (HTTP : es) a -> Eff es a
+runHTTP = evalData (DataA HTTP)
+
+open :: HTTP :> es => String -> Eff es ()
+open _ = pure ()
+
+close :: HTTP :> es => Eff es ()
+close = pure ()
+
+post :: HTTP :> es => String -> Eff es String
+post a = pure ("posted" <> a)
+
+get :: HTTP :> es => Eff es String
+get = pure "gotten"
+
+doHTTP :: HTTP :> es => Int -> Eff es Int
+doHTTP n = do
+  open "cats"
+  replicateM_ n (get *> post "cats")
+  close
+  pure n

instances/Effectful/Static/Stateful.hs

@@ -0,0 +1,7 @@
+module Effectful.Static.Stateful where
+
+import Effectful
+import Effectful.State.Local
+
+countDownPut :: State Int :> es => Eff es Int
+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)

instances/Effectful/Static/StatefulExcept.hs

@@ -0,0 +1,10 @@
+module Effectful.Static.StatefulExcept where
+
+import Effectful
+import Effectful.Error
+import Effectful.State.Local
+
+countDownExc :: (State Int :> es, Error String :> es) => Eff es b
+countDownExc = go
+  where
+    go = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> go)

package.yaml

@@ -12,6 +12,8 @@ benchmarks:
       - extensible-effects
       - gauge
       - weigh
+      - effectful
+      - effectful-core
     source-dirs:
       - instances
       - src

src/Main.hs

@@ -4,6 +4,8 @@
 
 module Main where
 
+import qualified Effectful.Dynamic.Bench as EffectfulDynamic
+import qualified Effectful.Static.Bench as EffectfulStatic
 import qualified ExtEff.Bench as ExtEff
 import qualified Freer.Bench as Freer
 import qualified Fused.Bench as Fused
@@ -33,7 +35,9 @@ main = do
               bench "polysemy" (nf Poly.countDownBench runs),
               bench "freer-simple" (nf Freer.countDownBench runs),
               bench "extensible-effects" (nf ExtEff.countDownBench runs),
-              bench "shallow" (nf Shallow.countDownBench runs)
+              bench "shallow" (nf Shallow.countDownBench runs),
+              bench "effectful - static" (nf EffectfulStatic.countDownBench runs),
+              bench "effectful - dynamic" (nf EffectfulDynamic.countDownBench runs)
             ],
           bgroup
             "Put+Exc"
@@ -42,7 +46,9 @@ main = do
               bench "polysemy" (nf Poly.countDownExcBench runs),
               bench "freer-simple" (nf Freer.countDownExcBench runs),
               bench "extensible-effects" (nf ExtEff.countDownExcBench runs),
-              bench "shallow" (nf Shallow.countDownExcBench runs)
+              bench "shallow" (nf Shallow.countDownExcBench runs),
+              bench "effectful - static" (nf EffectfulStatic.countDownExcBench runs),
+              bench "effectful - dynamic" (nf EffectfulDynamic.countDownExcBench runs)
             ]
         ],
       bgroup
@@ -52,7 +58,9 @@ main = do
           bench "extensible-effects" (nfAppIO ExtEff.httpBench runs),
           bench "Deep embedding" (nfAppIO MTL.httpBench runs),
           bench "Shallow embedding" (nfAppIO Shallow.httpBench runs),
-          bench "freer-simple" (nfAppIO Freer.httpBench runs)
+          bench "freer-simple" (nfAppIO Freer.httpBench runs),
+          bench "effectful - static" (nfAppIO EffectfulStatic.httpBench runs),
+          bench "effectful - dynamic" (nfAppIO EffectfulDynamic.httpBench runs)
         ]
     ]
 
@@ -65,7 +73,9 @@ main = do
           Weigh.func "polysemy" Poly.countDownBench wruns,
           Weigh.func "freer-simple" Freer.countDownBench wruns,
           Weigh.func "extensible-effects" ExtEff.countDownBench wruns,
-          Weigh.func "shallow" Shallow.countDownBench wruns
+          Weigh.func "shallow" Shallow.countDownBench wruns,
+          Weigh.func "effectful - static" EffectfulStatic.countDownBench runs,
+          Weigh.func "effectful - dynamic" EffectfulDynamic.countDownBench runs
         ]
     Weigh.wgroup "Countdown + exc" $
       sequence_
@@ -74,5 +84,7 @@ main = do
           Weigh.func "polysemy" Poly.countDownExcBench wruns,
           Weigh.func "freer-simple" Freer.countDownExcBench wruns,
           Weigh.func "extensible-effects" ExtEff.countDownExcBench wruns,
-          Weigh.func "shallow" Shallow.countDownExcBench wruns
+          Weigh.func "shallow" Shallow.countDownExcBench wruns,
+          Weigh.func "effectful - static" EffectfulStatic.countDownExcBench runs,
+          Weigh.func "effectful - dynamic" EffectfulDynamic.countDownExcBench runs
         ]

stack.yaml

@@ -41,6 +41,13 @@ packages:
 #
 extra-deps:
   - fused-effects-1.1.1.1
+  - git: https://github.com/arybczak/effectful.git
+    commit: 0d0283948ddd3204f69cdc60871978efe21452ae
+    subdir: effectful
+  - git: https://github.com/arybczak/effectful.git
+    commit: 0d0283948ddd3204f69cdc60871978efe21452ae
+    subdir: effectful-core
+
 # Override default flag values for local packages and extra-deps
 # flags: {}