Fix scoped within scoped incoherency. Add runScopedNew (#466)

ChangeLog.md

@@ -6,6 +6,22 @@
 
 ### Other Changes
 
+## 1.9.0.0 (2022-12-28)
+
+### Breaking Changes
+- Slightly modified the signatures of the various `Scoped` interpreters.
+
+### Other Changes
+- Added `runScopedNew`, a simple but powerful `Scoped` interpreter.
+  `runScopedNew` can be considered a sneak-peek of the future of `Scoped`,
+  which will eventually receive a major API rework to make it both simpler and
+  more expressive.
+- Fixed a bug in various `Scoped` interpreters where a `scoped` usage of an
+  effect always relied on the nearest enclosing use of `scoped` from the same
+  `Scoped` effect, rather than the `scoped` which handles the effect.
+- Added `Polysemy.Opaque`, a module for the `Opaque` effect newtype, meant as
+  a tool to wrap polymorphic effect variables so they don't jam up resolution of
+  `Member` constraints.
 - Expose the type alias `Scoped_` for a scoped effect without callsite parameters.
 
 ## 1.8.0.0 (2022-12-22)

polysemy-plugin/polysemy-plugin.cabal

@@ -1,6 +1,6 @@
 cabal-version: 2.0
 
--- This file has been generated from package.yaml by hpack version 0.34.7.
+-- This file has been generated from package.yaml by hpack version 0.35.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -122,6 +122,6 @@ test-suite polysemy-plugin-test
     , should-not-typecheck >=2.1.0 && <3
     , syb ==0.7.*
     , transformers >=0.5.2.0 && <0.6
+  default-language: Haskell2010
   if flag(corelint)
     ghc-options: -dcore-lint -dsuppress-all
-  default-language: Haskell2010

polysemy.cabal

@@ -1,6 +1,6 @@
 cabal-version: 2.0
 
--- This file has been generated from package.yaml by hpack version 0.34.7.
+-- This file has been generated from package.yaml by hpack version 0.35.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -65,6 +65,7 @@ library
       Polysemy.IO
       Polysemy.Membership
       Polysemy.NonDet
+      Polysemy.Opaque
       Polysemy.Output
       Polysemy.Reader
       Polysemy.Resource
@@ -109,14 +110,14 @@ library
     , transformers >=0.5.2.0 && <0.6
     , type-errors >=0.2.0.0
     , unagi-chan >=0.4.0.0 && <0.5
+  default-language: Haskell2010
   if impl(ghc < 8.6)
     default-extensions:
         MonadFailDesugaring
         TypeInType
   if impl(ghc < 8.2.2)
     build-depends:
         unsupported-ghc-version >1 && <1
-  default-language: Haskell2010
 
 test-suite polysemy-test
   type: exitcode-stdio-1.0
@@ -180,8 +181,8 @@ test-suite polysemy-test
     , transformers >=0.5.2.0 && <0.6
     , type-errors >=0.2.0.0
     , unagi-chan >=0.4.0.0 && <0.5
+  default-language: Haskell2010
   if impl(ghc < 8.6)
     default-extensions:
         MonadFailDesugaring
         TypeInType
-  default-language: Haskell2010

src/Polysemy/Internal/Scoped.hs

@@ -103,8 +103,11 @@ import Polysemy
 --
 -- The type 'Scoped_' and the constructor 'scoped_' simply fix @param@ to @()@.
 data Scoped (param :: Type) (effect :: Effect) :: Effect where
-  Run :: ∀ param effect m a . effect m a -> Scoped param effect m a
-  InScope :: ∀ param effect m a . param -> m a -> Scoped param effect m a
+  Run :: ∀ param effect m a . Word -> effect m a -> Scoped param effect m a
+  InScope :: ∀ param effect m a . param -> (Word -> m a) -> Scoped param effect m a
+
+data OuterRun (effect :: Effect) :: Effect where
+  OuterRun :: ∀ effect m a . Word -> effect m a -> OuterRun effect m a
 
 -- |A convenience alias for a scope without parameters.
 type Scoped_ effect =
@@ -120,8 +123,8 @@ scoped ::
   param ->
   InterpreterFor effect r
 scoped param main =
-  send $ InScope @param @effect param do
-    transform @effect (Run @param) main
+  send $ InScope @param @effect param $ \w ->
+    transform @effect (Run @param w) main
 {-# inline scoped #-}
 
 -- | Constructor for 'Scoped_', taking a nested program and transforming all
@@ -148,7 +151,7 @@ rescope ::
   InterpreterFor (Scoped param0 effect) r
 rescope fp =
   transform \case
-    Run e          -> Run @param1 e
+    Run w e        -> Run @param1 w e
     InScope p main -> InScope (fp p) main
 {-# inline rescope #-}
 

src/Polysemy/Opaque.hs

@@ -0,0 +1,53 @@
+module Polysemy.Opaque (
+  -- * Effect
+  Opaque(..),
+
+  -- * Interpreters
+  toOpaque,
+  fromOpaque,
+  ) where
+
+import Polysemy
+
+-- | An effect newtype meant to be used to wrap polymorphic effect variables to
+-- prevent them from jamming up resolution of 'Polysemy.Member'.
+-- For example, consider:
+--
+-- @
+-- badPut :: 'Sem' (e ': 'Polysemy.State.State' () ': r) ()
+-- badPut = 'Polysemy.State.put' () -- error
+-- @
+--
+-- This fails to compile. This is because @e@ /could/ be
+-- @'Polysemy.State.State' ()@' -- in which case the 'Polysemy.State.put'
+-- should target it instead of the concretely provided
+-- @'Polysemy.State.State' ()@; as the compiler can't know for sure which effect
+-- should be targeted, the program is rejected.
+-- There are various ways to resolve this, including using 'raise' or
+-- 'Polysemy.Membership.subsumeUsing'. 'Opaque' provides another way:
+--
+-- @
+-- okPut :: 'Sem' (e ': 'Polysemy.State.State' () ': r) ()
+-- okPut = 'fromOpaque' ('Polysemy.State.put' ()) -- OK
+-- @
+--
+-- 'Opaque' is most useful as a tool for library writers, in the case where some
+-- function of the library requires the user to work with an effect stack
+-- containing some polymorphic effect variables. By wrapping the polymorphic
+-- effect variables using 'Opaque', users of the function can use effects as
+-- normal, without having to use 'raise' or 'Polysemy.Membership.subsumeUsing'
+-- in order to have 'Polysemy.Member' resolve. The various interpreters of
+-- 'Polysemy.Scoped.Scoped' are examples of such usage of 'Opaque'.
+--
+-- @since 1.9.0.0
+newtype Opaque (e :: Effect) m a = Opaque (e m a)
+
+-- | Wrap 'Opaque' around the top effect of the effect stack
+toOpaque :: Sem (e ': r) a -> Sem (Opaque e ': r) a
+toOpaque = rewrite Opaque
+{-# INLINE toOpaque #-}
+
+-- | Unwrap 'Opaque' around the top effect of the effect stack
+fromOpaque :: Sem (Opaque e ': r) a -> Sem (e ': r) a
+fromOpaque = rewrite (\(Opaque e) -> e)
+{-# INLINE fromOpaque #-}