Feat: Change Underlying Rep of Environment

.github/workflows/ci.yml

@@ -2,9 +2,12 @@ name: CI
 
 on:
     pull_request:
+        types: [synchronize, opened, reopened]
     push:
-        branches:
-            - master
+        branches: [master]
+    schedule:
+        # Run once per week (At 00:00 on Sunday) to maintain cache
+        - cron: '0 0 * * 0'
 
 jobs:
     workflow:

.github/workflows/style.yml

@@ -2,9 +2,9 @@ name: Code Style
 
 on:
     pull_request:
+        types: [synchronize, opened, reopened]
     push:
-        braches:
-            - master
+        branches: [master]
 
 jobs:
     checks:

spago.dhall

@@ -24,9 +24,13 @@ to generate this file without the comments in this block.
   , "transformers"
   , "typelevel-prelude"
   , "unsafe-coerce"
+  , "variant"
+  , "veither"
+  , "refs"
+  , "tuples"
   ]
 , packages = ./packages.dhall
-, sources = [ "src/**/*.purs" ]
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
 , license = "MPL-2.0"
 , repository = "https://github.com/the-dr-lazy/purescript-effectful"
 }

src/Control/Eff.purs

@@ -1,7 +1,7 @@
 {-|
 Module     : Control.Eff
 Maintainer : Mohammad Hasani (the-dr-lazy.github.io) <[email protected]>
-Copyright  : (c) 2021-2022 Effecful
+Copyright  : (c) 2021-2024 Effecful
 License    : MPL 2.0
 
 This Source Code Form is subject to the terms of the Mozilla Public
@@ -10,29 +10,33 @@ file, You can obtain one at http://mozilla.org/MPL/2.0/.
 -}
 
 module Control.Eff
-  ( module Control.Eff.Algebra
+  ( Eff(..)
   , Environment
-  , Action(..)
-  , Eff(..)
-  , mk
-  , un
-  , unsafeMkFromAff
+  , Handler
+  , expand
+  , impose
+  , interpose
   , interpret
-  , intercept
+  , module Control.Eff.Algebra
   , reinterpret
-  , expand
-  , send
   , run
+  , send
+  , un
+  , unsafeMkFromAff
+  , addHandler
   ) where
 
+import Control.Eff.Algebra
 import Prelude
 
-import Control.Eff.Algebra
 import Control.Eff.Algebra as Eff
-import Control.Eff.Variant as Eff
-import Control.Eff.Variant as Eff.Variant
+import Control.Eff.Variant (Variant)
+import Control.Eff.Variant as Variant
 import Data.Symbol (class IsSymbol)
 import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
+import Effect.Ref (Ref)
+import Effect.Ref as Ref
 import Type.Proxy (Proxy)
 import Type.Row as Row
 import Unsafe.Coerce (unsafeCoerce)
@@ -54,77 +58,123 @@ instance Applicative (Eff r) where
 instance Bind (Eff r) where
   bind (UnsafeMk m) f = UnsafeMk \environment -> do
     x <- m environment
-    un (f x) environment
+    un environment (f x)
 
 instance Monad (Eff r)
 
-type Environment r = Eff.Variant r (Eff r) ~> Action r
+type Handler :: Type
+type Handler = forall a. Variant -> Aff a
 
-data Action r a = Intercept (Environment r) (Eff r a) | Interpret (Eff r a) | Perform (Aff a)
+type Environment :: Row Algebra -> Type
+type Environment r = Ref Handler
 
-mk :: forall r. Eff.Variant r (Eff r) ~> Eff r
-mk f = UnsafeMk \environment -> do
-  case environment f of
-    Perform m -> m
-    Interpret (UnsafeMk m) -> m environment
-    Intercept env (UnsafeMk m) -> m env
+-- mk :: forall r a. Variant -> Eff r a
+-- mk f = UnsafeMk \m -> m f
 
 unsafeMkFromAff :: forall r. Aff ~> Eff r
 unsafeMkFromAff m = UnsafeMk \_ -> m
 
-un :: forall r a. Eff r a -> Environment r -> Aff a
-un (UnsafeMk m) = m
+un :: forall r a. Environment r -> Eff r a -> Aff a
+un ref (UnsafeMk m) = m ref
+
+type EffectHandler f fr = f (Eff fr) ~> Eff fr
+
+handle :: forall tag f r fr. IsSymbol tag => Row.Cons tag f r fr => Environment fr -> Proxy tag -> f (Eff fr) ~> Aff
+handle environment ptag f = do
+  handler <- liftEffect $ Ref.read environment
+
+  handler (Variant.inject ptag f)
+
+addHandler :: forall tag f r fr a. IsSymbol tag => Row.Cons tag f r fr => Environment r -> Proxy tag -> (f (Eff fr) a -> Eff fr a) -> Aff (Environment fr)
+addHandler environment ptag handler = do
+  liftEffect $ Ref.modify_ (Variant.on ptag (un environment <<< handler)) (unsafeCoerce environment)
+
+  pure (unsafeCoerce environment)
+
+getHandler :: forall tag f r fr a. IsSymbol tag => Row.Cons tag f r fr => Environment fr -> Proxy tag -> Aff (Eff fr a -> Eff r a)
+getHandler environment ptag = do
+  handler <- liftEffect $ Ref.read environment
+  environment' <- liftEffect $ Ref.new (unsafeCoerce handler)
+
+  pure $ \(UnsafeMk m) -> UnsafeMk \_ -> m environment'
 
 send
-  :: forall tag f r fr a
+  :: forall tag f r fr
    . IsSymbol tag
   => Functor (f (Eff fr))
   => Row.Cons tag f r fr
   => Proxy tag
-  -> f (Eff fr) a
-  -> Eff fr a
-send ptag f = mk (Eff.Variant.inject ptag f)
+  -> f (Eff fr)
+       ~> Eff fr
+send ptag f = UnsafeMk \environment -> handle environment ptag f
 
 interpret
-  :: forall tag from r fromr
-   . Row.Cons tag from r fromr
-  => Functor (from (Eff fromr))
+  :: forall tag f r fr
+   . Row.Cons tag f r fr
+  => Functor (f (Eff fr))
   => IsSymbol tag
   => Proxy tag
-  -> (from (Eff fromr) ~> Eff fromr)
-  -> Eff fromr
+  -> EffectHandler f fr
+  -> Eff fr
        ~> Eff r
 interpret ptag interpreter (UnsafeMk m) =
-  UnsafeMk \environment ->
-    m (Eff.Variant.interpret ptag (Interpret <<< interpreter) (unsafeCoerce environment))
+  UnsafeMk \r -> do
+    fr <- addHandler r ptag interpreter
+    m fr
+
+reinterpret
+  :: forall tag f r fr h a b
+   . Row.Cons tag f r fr
+  => IsSymbol tag
+  => Functor (f (Eff fr))
+  => Proxy tag
+  -> (Eff h a -> Eff fr b)
+  -> EffectHandler f h
+  -> Eff fr a
+  -> Eff r b
+reinterpret ptag run handler m =
+  (unsafeCoerce run) $ interpret ptag (unsafeCoerce handler) m
 
-intercept
-  :: forall tag from r fromr
-   . Row.Cons tag from r fromr
+interpose
+  :: forall tag f r fr a
+   . Row.Cons tag f r fr
   => IsSymbol tag
-  => Functor (from (Eff fromr))
+  => Functor (f (Eff fr))
   => Proxy tag
-  -> (from (Eff fromr) ~> Eff fromr)
-  -> Eff fromr
-       ~> Eff fromr
-intercept ptag interceptor (UnsafeMk m) =
-  UnsafeMk \environment ->
-    m (Eff.Variant.intercept ptag (interceptor >>> Intercept environment) environment)
+  -> EffectHandler f fr
+  -> Eff fr a
+  -> Eff fr a
+interpose ptag handler (UnsafeMk m) =
+  UnsafeMk \environment -> do
+    run <- getHandler environment ptag
 
-expand :: forall from r fromr. Row.Union from r fromr => Eff from ~> Eff fromr
-expand = unsafeCoerce
+    let
+      f :: f (Eff fr) a -> Eff r a
+      f = run <<< handler
 
-reinterpret
-  :: forall tag from r tor fromr fromtor
-   . Row.Cons tag from r fromr
-  => Row.Cons tag from tor fromtor
-  => IsSymbol tag
-  => Functor (from (Eff fromtor))
+      u :: f (Eff fr) a -> Eff fr a
+      u = unsafeCoerce
+
+    _ <- addHandler environment ptag u
+
+    m environment
+
+impose
+  :: forall tag f r fr h a b
+   . IsSymbol tag
+  => Row.Cons tag f r fr
+  => Functor (f (Eff fr))
   => Proxy tag
-  -> (from (Eff fromtor) ~> Eff fromtor)
-  -> Eff fromr
-       ~> Eff tor
-reinterpret ptag reinterpreter m = interpret ptag reinterpreter (unsafeCoerce m)
+  -> (Eff h a -> Eff fr b)
+  -> EffectHandler f h
+  -> Eff fr a
+  -> Eff fr b
+impose ptag run handler m = (unsafeCoerce run) $ interpose ptag (unsafeCoerce handler) m
+
+expand :: forall from r fromr. Row.Union from r fromr => Eff from ~> Eff fromr
+expand = unsafeCoerce
 
-run :: forall a. Eff () a -> Aff a
-run (UnsafeMk m) = m Eff.Variant.empty
+run :: Eff () ~> Aff
+run (UnsafeMk m) = do
+  ref <- liftEffect $ unsafeCoerce (Ref.new Variant.empty)
+  m ref

src/Control/Eff/Algebra.purs

@@ -1,7 +1,7 @@
 {-|
 Module     : Control.Eff.Algebra
 Maintainer : Mohammad Hasani (the-dr-lazy.github.io) <[email protected]>
-Copyright  : (c) 2021-2022 Effecful
+Copyright  : (c) 2021-2024 Effecful
 License    : MPL 2.0
 
 This Source Code Form is subject to the terms of the Mozilla Public

src/Control/Eff/Except.js

@@ -1,25 +1,29 @@
 /*
  * Maintainer : Mohammad Hasani (the-dr-lazy.github.io) <[email protected]>
- * Copyright  : (c) 2021-2022 Effecful
+ * Copyright  : (c) 2021-2024 Effecful
  * License    : MPL 2.0
  *
  * This Source Code Form is subject to the terms of the Mozilla Public
  * License, version 2.0. If a copy of the MPL was not distributed with this
  * file, You can obtain one at http://mozilla.org/MPL/2.0/.
  */
 
+var _symbol = Symbol('Except')
+
 exports.foreign_mkCustomError = function (r) {
     var e = new Error('Control.Eff.Except: unhandled exception (' + r.tag + ')')
-    e._tag = r.tag
-    e._value = r.value
+
+    e[_symbol] = r
 
     return e
 }
 
-exports.foreign_parseCustomError = function (r) {
-    if (r.error._tag !== r.tag) {
+exports.foreign_parseCustomError = function (error) {
+    const r = e[_symbol]
+
+    if (r !== undefined) {
         return null
     }
 
-    return r.error._value
+    return r
 }