polysemy-research/polysemy
1
1
Fork 0
mirror of https://github.com/polysemy-research/polysemy.git synced 2024-10-26 02:49:58 +03:00
Code Issues Projects Releases Wiki Activity

Extend Scoped (#459)

Browse Source 
* add variants of interpretScoped that allow additional local effects
* add call site parameter to Scoped
This commit is contained in:
KingoftheHomeless 2022-10-02 18:49:17 +02:00 committed by GitHub
parent f2c36c40cc
commit 76af343a96
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 421 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
polysemy-plugin/polysemy-plugin.cabal
View File

@ -1,6 +1,6 @@
cabal-version: 2.0
-- This file has been generated from package.yaml by hpack version 0.34.4.
-- This file has been generated from package.yaml by hpack version 0.35.0.
--
-- see: https://github.com/sol/hpack
@ -89,6 +89,7 @@ test-suite polysemy-plugin-test
Paths_polysemy_plugin
Build_doctests
autogen-modules:
Paths_polysemy_plugin
Build_doctests
hs-source-dirs:
test
@ -122,6 +123,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

11
polysemy.cabal
View File

@ -1,6 +1,6 @@
cabal-version: 2.0
-- This file has been generated from package.yaml by hpack version 0.34.5.
-- This file has been generated from package.yaml by hpack version 0.35.0.
--
-- see: https://github.com/sol/hpack
@ -114,6 +114,7 @@ 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
@ -125,7 +126,6 @@ library
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
@ -150,6 +150,7 @@ test-suite polysemy-test
Paths_polysemy
Build_doctests
autogen-modules:
Paths_polysemy
Build_doctests
hs-source-dirs:
test
@ -175,10 +176,10 @@ test-suite polysemy-test
async >=2.2 && <3
, base >=4.9 && <5
, containers >=0.5 && <0.7
, doctest >=0.16.0.1 && <0.20
, doctest >=0.16.0.1 && <0.19
, first-class-families >=0.5.0.0 && <0.9
, hspec >=2.6.0 && <3
, inspection-testing >=0.4.2 && <0.6
, inspection-testing >=0.4.2 && <0.5
, mtl >=2.2.2 && <3
, polysemy
, stm ==2.*
@ -188,8 +189,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

6
src/Polysemy/Internal.hs
View File

@ -34,6 +34,7 @@ module Polysemy.Internal
, usingSem
, liftSem
, hoistSem
, restack
, Append
, InterpreterFor
, InterpretersFor
@ -343,6 +344,11 @@ hoistSem
hoistSem nat (Sem m) = Sem $ \k -> m $ \u -> k $ nat u
{-# INLINE hoistSem #-}
restack :: (forall e. ElemOf e r -> ElemOf e r')
-> Sem r a
-> Sem r' a
restack n = hoistSem $ \(Union pr wav) -> hoist (restack n) $ Union (n pr) wav
{-# INLINE restack #-}
------------------------------------------------------------------------------
-- | Introduce an arbitrary number of effects on top of the effect stack. This

14
src/Polysemy/Internal/Combinators.hs
View File

@ -18,6 +18,7 @@ module Polysemy.Internal.Combinators
, reinterpretH
, reinterpret2H
, reinterpret3H
, interpretWeaving
-- * Conditional
, interceptUsing
@ -28,6 +29,7 @@ module Polysemy.Internal.Combinators
, lazilyStateful
) where
import Control.Arrow ((>>>))
import Control.Monad
import qualified Control.Monad.Trans.State.Lazy as LS
import qualified Control.Monad.Trans.State.Strict as S
@ -87,6 +89,18 @@ interpretH f (Sem m) = Sem $ \k -> m $ \u ->
fmap y $ usingSem k $ runTactics s d v (interpretH f . d) $ f e
{-# INLINE interpretH #-}
-- | Interpret an effect @e@ through a natural transformation from @Weaving e@
-- to @Sem r@
interpretWeaving ::
∀ e r .
(∀ x . Weaving e (Sem (e : r)) x -> Sem r x) ->
InterpreterFor e r
interpretWeaving h (Sem m) =
Sem \ k -> m $ decomp >>> \case
Right wav -> runSem (h wav) k
Left g -> k $ hoist (interpretWeaving h) g
{-# inline interpretWeaving #-}
------------------------------------------------------------------------------
-- | A highly-performant combinator for interpreting an effect statefully. See
-- 'stateful' for a more user-friendly variety of this function.

175
src/Polysemy/Internal/Scoped.hs
View File

@ -3,48 +3,157 @@
module Polysemy.Internal.Scoped where
import Polysemy.Internal (send, Member, InterpreterFor, Sem(Sem), runSem)
import Data.Kind (Type)
import Polysemy.Internal.Kind (Effect)
import Polysemy.Internal.Union (Weaving, hoist, decomp)
import Control.Arrow ((>>>))
import Polysemy.Internal.Combinators (transform)
-- |@Scoped@ transforms a program so that @effect@ is associated with a @resource@ within that program.
-- This requires the interpreter for @effect@ to be parameterized by @resource@ and constructed for every program using
import Polysemy
-- | @Scoped@ transforms a program so that @effect@ is associated with a
-- @resource@ within that program. This requires the interpreter for @effect@ to
-- be parameterized by @resource@ and constructed for every program using
-- @Scoped@ separately.
--
-- An application for this is @Polysemy.Conc.Events@ from <https://hackage.haskell.org/package/polysemy-conc>,
-- in which each program using the effect @Polysemy.Conc.Consume@ is interpreted with its own copy of the event channel;
-- or a database transaction, in which a transaction handle is created for the wrapped program and passed
-- to the interpreter for the database effect.
-- An application for this is @Polysemy.Conc.Events@ from
-- <https://hackage.haskell.org/package/polysemy-conc>, in which each program
-- using the effect @Polysemy.Conc.Consume@ is interpreted with its own copy of
-- the event channel; or a database transaction, in which a transaction handle
-- is created for the wrapped program and passed to the interpreter for the
-- database effect.
--
-- For a longer exposition, see <https://www.tweag.io/blog/2022-01-05-polysemy-scoped/>.
--
-- Resource creation is performed by the function passed to 'Polysemy.Scoped.runScoped'.
-- Resource allocation is performed by a function passed to
-- 'Polysemy.Scoped.interpretScoped'.
--
-- The constructors are not intended to be used directly; the smart constructor 'scoped' is used like a local
-- interpreter for @effect@.
data Scoped (resource :: Type) (effect :: Effect) :: Effect where
Run :: ∀ resource effect m a . resource -> effect m a -> Scoped resource effect m a
InScope :: ∀ resource effect m a . (resource -> m a) -> Scoped resource effect m a
-- The constructors are not intended to be used directly; the smart constructor
-- 'scoped' is used like a local interpreter for @effect@. 'scoped' takes an
-- argument of type @param@, which will be passed through to the interpreter, to
-- be used by the resource allocation function.
--
-- As an example, imagine an effect for writing lines to a file:
--
-- > data Write :: Effect where
-- > Write :: Text -> Write m ()
-- > makeSem ''Write
--
-- If we now have the following requirements:
--
-- 1. The file should be opened and closed right before and after the part of
-- the program in which we write lines
-- 2. The file name should be specifiable at the point in the program where
-- writing begins
-- 3. We don't want to commit to IO, lines should be stored in memory when
-- running tests
--
-- Then we can take advantage of 'Scoped' to write this program:
--
-- > prog :: Member (Scoped FilePath resource Write) r => Sem r ()
-- > prog = do
-- > scoped "file1.txt" do
-- > write "line 1"
-- > write "line 2"
-- > scoped "file2.txt" do
-- > write "line 1"
-- > write "line 2"
--
-- Here 'scoped' creates a prompt for an interpreter to start allocating a
-- resource for @"file1.txt"@ and handling @Write@ actions using that resource.
-- When the 'scoped' block ends, the resource should be freed.
--
-- The interpreter may look like this:
--
-- > interpretWriteFile :: Members '[Resource, Embed IO] => InterpreterFor (Scoped FilePath Handle Write) r
-- > interpretWriteFile =
-- > interpretScoped allocator handler
-- > where
-- > allocator name use = bracket (openFile name WriteMode) hClose use
-- > handler fileHandle (Write line) = embed (Text.hPutStrLn fileHandle line)
--
-- Essentially, the @bracket@ is executed at the point where @scoped@ was
-- called, wrapping the following block. When the second @scoped@ is executed,
-- another call to @bracket@ is performed.
--
-- The effect of this is that the operation that uses @Embed IO@ was moved from
-- the call site to the interpreter, while the interpreter may be executed at
-- the outermost layer of the app.
--
-- This makes it possible to use a pure interpreter for testing:
--
-- > interpretWriteOutput :: Member (Output (FilePath, Text)) r => InterpreterFor (Scoped FilePath FilePath Write) r
-- > interpretWriteOutput =
-- > interpretScoped (\ name use -> use name) \ name -> \case
-- > Write line -> output (name, line)
--
-- Here we simply pass the name to the interpreter in the resource allocation
-- function. Note how the type of the effect changed, with the @resource@
-- parameter being instantiated as @FilePath@ instead of @Handle@.
-- This change does not need to be anticipated in the business logic that uses
-- the scoped effect – as is visible in the signature of @prog@, the @resource@
-- parameter is always chosen concretely by an interpreter.
--
-- Now imagine that we drop requirement 2 from the initial list – we still want
-- the file to be opened and closed as late/early as possible, but the file name
-- is globally fixed. For this case, the @param@ type is unused, and the API
-- provides some convenience aliases to make your code more concise:
--
-- > prog :: Member (Scoped_ resource Write) r => Sem r ()
-- > prog = do
-- > scoped_ do
-- > write "line 1"
-- > write "line 2"
-- > scoped_ do
-- > write "line 1"
-- > write "line 2"
--
-- The type 'Scoped_' and the constructor 'scoped_' simply fix @param@ to @()@.
data Scoped (param :: Type) (resource :: Type) (effect :: Effect) :: Effect where
Run :: ∀ param resource effect m a . resource -> effect m a ->
Scoped param resource effect m a
InScope :: ∀ param resource effect m a . param -> (resource -> m a) ->
Scoped param resource effect m a
-- |Constructor for 'Scoped', taking a nested program and transforming all instances of @effect@ to
-- @Scoped resource effect@.
-- |A convenience alias for a scope without parameters.
type Scoped_ resource effect =
Scoped () resource effect
-- | Constructor for 'Scoped', taking a nested program and transforming all
-- instances of @effect@ to @'Scoped' param resource effect@.
--
-- Please consult the documentation of 'Scoped' for details and examples.
scoped ::
∀ resource effect r .
Member (Scoped resource effect) r =>
∀ resource param effect r .
Member (Scoped param resource effect) r =>
param ->
InterpreterFor effect r
scoped main =
send $ InScope @resource @effect \ resource ->
transform @effect (Run resource) main
scoped param main =
send $ InScope @param @resource @effect param \ resource ->
transform @effect (Run @param resource) main
{-# inline scoped #-}
-- | Constructor for 'Scoped_', taking a nested program and transforming all
-- instances of @effect@ to @'Scoped_' resource effect@.
--
-- Please consult the documentation of 'Scoped' for details and examples.
scoped_ ::
∀ resource effect r .
Member (Scoped_ resource effect) r =>
InterpreterFor effect r
scoped_ = scoped @resource ()
{-# inline scoped_ #-}
-- | Transform the parameters of a 'Scoped' program.
--
-- This allows incremental additions to the data passed to the interpreter, for
-- example to create an API that permits different ways of running an effect
-- with some fundamental parameters being supplied at scope creation and some
-- optional or specific parameters being selected by the user downstream.
rescope ::
∀ param0 param1 resource effect r .
Member (Scoped param1 resource effect) r =>
(param0 -> param1) ->
InterpreterFor (Scoped param0 resource effect) r
rescope fp =
transform \case
Run res e -> Run @param1 res e
InScope p main -> InScope (fp p) main
{-# inline rescope #-}
-- |Helper for @runScoped@.
interpretH' ::
∀ e r .
(∀ x . Weaving e (Sem (e : r)) x -> Sem r x) ->
InterpreterFor e r
interpretH' h (Sem m) =
Sem \ k -> m $ decomp >>> \case
Right wav -> runSem (h wav) k
Left g -> k $ hoist (interpretH' h) g

324
src/Polysemy/Scoped.hs
View File

@ -1,100 +1,274 @@
{-# language AllowAmbiguousTypes #-}
module Polysemy.Scoped (
-- * Effect
Scoped,
-- * Constructor
-- * Constructors
scoped,
scoped_,
rescope,
-- * Interpreters
runScoped,
runScopedAs,
interpretScopedH,
interpretScopedH',
interpretScoped,
interpretScopedAs,
interpretScopedWithH,
interpretScopedWith,
interpretScopedWith_,
runScoped,
runScopedAs,
) where
import Polysemy.Internal (InterpreterFor, Sem, liftSem, raise)
import Polysemy.Internal.Scoped (Scoped (Run, InScope), scoped, interpretH')
import Polysemy.Internal.Union (Weaving(Weaving), injWeaving)
import Polysemy.Internal.Tactics (Tactical, runTactics)
import Polysemy.Internal
import Polysemy.Internal.Sing
import Polysemy.Internal.Union
import Polysemy.Internal.Combinators
import Polysemy.Internal.Scoped
import Polysemy.Internal.Tactics
-- |Interpreter for 'Scoped', taking a @resource@ allocation function and a parameterized interpreter for the plain
-- @effect@.
-- | Construct an interpreter for a higher-order effect wrapped in a 'Scoped',
-- given a resource allocation function and a parameterized handler for the
-- plain effect.
--
-- >>> runScoped withResource scopedInterpreter
--
-- @withResource@ is a callback function, allowing the user to acquire the resource for each program from other effects.
--
-- @scopedInterpreter@ is a regular interpreter that is called with the @resource@ argument produced by @scope@.
--
-- /Note/: This function will be called for each action in the program, so if the interpreter allocates any resources,
-- they will be scoped to a single action. Move them to @withResource@ instead.
runScoped ::
∀ resource effect r .
(∀ x . (resource -> Sem r x) -> Sem r x) ->
(resource -> InterpreterFor effect r) ->
InterpreterFor (Scoped resource effect) r
runScoped withResource scopedInterpreter =
run
where
run :: InterpreterFor (Scoped resource effect) r
run =
interpretH' \ (Weaving effect s wv ex ins) -> case effect of
Run resource act ->
scopedInterpreter resource (liftSem $ injWeaving $ Weaving act s (raise . run . wv) ex ins)
InScope main ->
ex <$> withResource \ resource -> run (wv (main resource <$ s))
-- |Variant of 'runScoped' in which the resource allocator is a plain action.
runScopedAs ::
∀ resource effect r .
Sem r resource ->
(resource -> InterpreterFor effect r) ->
InterpreterFor (Scoped resource effect) r
runScopedAs resource =
runScoped \ f -> f =<< resource
-- |Variant of 'runScoped' that takes a higher-order handler instead of an interpreter.
-- This combinator is analogous to 'interpretH' in that it allows the handler to
-- use the 'Tactical' environment and transforms the effect into other effects
-- on the stack.
interpretScopedH ::
∀ resource effect r .
(∀ x . (resource -> Sem r x) -> Sem r x) ->
∀ param resource effect r .
-- | A callback function that allows the user to acquire a resource for each
-- computation wrapped by 'scoped' using other effects, with an additional
-- argument that contains the call site parameter passed to 'scoped'.
(∀ x . param -> (resource -> Sem r x) -> Sem r x) ->
-- | A handler like the one expected by 'interpretH' with an additional
-- parameter that contains the @resource@ allocated by the first argument.
(∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r x) ->
InterpreterFor (Scoped resource effect) r
InterpreterFor (Scoped param resource effect) r
interpretScopedH withResource scopedHandler =
run
go
where
run :: InterpreterFor (Scoped resource effect) r
run =
interpretH' \ (Weaving effect s wv ex ins) -> case effect of
go :: InterpreterFor (Scoped param resource effect) r
go =
interpretWeaving \ (Weaving effect s wv ex ins) -> case effect of
Run resource act ->
ex <$> runTactics s (raise . run . wv) ins (run . wv) (scopedHandler resource act)
InScope main ->
ex <$> withResource \ resource -> run (wv (main resource <$ s))
ex <$> runTactics s (raise . go . wv) ins (go . wv)
(scopedHandler resource act)
InScope param main ->
withResource param \ resource -> ex <$> go (wv (main resource <$ s))
{-# inline interpretScopedH #-}
-- |Variant of 'runScoped' that takes a handler instead of an interpreter.
-- | Variant of 'interpretScopedH' that allows the resource acquisition function
-- to use 'Tactical'.
interpretScopedH' ::
∀ resource param effect r .
(∀ e r0 x . param -> (resource -> Tactical e (Sem r0) r x) ->
Tactical e (Sem r0) r x) ->
(∀ r0 x .
resource -> effect (Sem r0) x ->
Tactical (Scoped param resource effect) (Sem r0) r x) ->
InterpreterFor (Scoped param resource effect) r
interpretScopedH' withResource scopedHandler =
interpretH \case
Run resource act ->
scopedHandler resource act
InScope param main ->
withResource param \ resource ->
runTSimple (main resource)
{-# inline interpretScopedH' #-}
-- | First-order variant of 'interpretScopedH'.
interpretScoped ::
∀ resource effect r .
(∀ x . (resource -> Sem r x) -> Sem r x) ->
(∀ r0 x . resource -> effect (Sem r0) x -> Sem r x) ->
InterpreterFor (Scoped resource effect) r
∀ resource param effect r .
(∀ x . param -> (resource -> Sem r x) -> Sem r x) ->
(∀ m x . resource -> effect m x -> Sem r x) ->
InterpreterFor (Scoped param resource effect) r
interpretScoped withResource scopedHandler =
run
where
run :: InterpreterFor (Scoped resource effect) r
run =
interpretH' \ (Weaving effect s wv ex _) -> case effect of
Run resource act -> do
x <- scopedHandler resource act
pure (ex (x <$ s))
InScope main ->
ex <$> withResource \ resource -> run (wv (main resource <$ s))
interpretScopedH withResource \ r e -> liftT (scopedHandler r e)
{-# inline interpretScoped #-}
-- |Variant of 'interpretScoped' in which the resource allocator is a plain action.
-- | Variant of 'interpretScoped' in which the resource allocator is a plain
-- action.
interpretScopedAs ::
∀ resource effect r .
Sem r resource ->
(∀ r0 x . resource -> effect (Sem r0) x -> Sem r x) ->
InterpreterFor (Scoped resource effect) r
∀ resource param effect r .
(param -> Sem r resource) ->
(∀ m x . resource -> effect m x -> Sem r x) ->
InterpreterFor (Scoped param resource effect) r
interpretScopedAs resource =
interpretScoped \ f -> f =<< resource
interpretScoped \ p use -> use =<< resource p
{-# inline interpretScopedAs #-}
-- | Higher-order interpreter for 'Scoped' that allows the handler to use
-- additional effects that are interpreted by the resource allocator.
--
-- /Note/: It is necessary to specify the list of local interpreters with a type
-- application; GHC won't be able to figure them out from the type of
-- @withResource@.
--
-- As an example for a higher order effect, consider a mutexed concurrent state
-- effect, where an effectful function may lock write access to the state while
-- making it still possible to read it:
--
-- > data MState s :: Effect where
-- > MState :: (s -> m (s, a)) -> MState s m a
-- > MRead :: MState s m s
-- >
-- > makeSem ''MState
--
-- We can now use an 'Polysemy.AtomicState.AtomicState' to store the current
-- value and lock write access with an @MVar@. Since the state callback is
-- effectful, we need a higher order interpreter:
--
-- > withResource ::
-- > Member (Embed IO) r =>
-- > s ->
-- > (MVar () -> Sem (AtomicState s : r) a) ->
-- > Sem r a
-- > withResource initial use = do
-- > tv <- embed (newTVarIO initial)
-- > lock <- embed (newMVar ())
-- > runAtomicStateTVar tv $ use lock
-- >
-- > interpretMState ::
-- > ∀ s r .
-- > Members [Resource, Embed IO] r =>
-- > InterpreterFor (Scoped s (MVar ()) (MState s)) r
-- > interpretMState =
-- > interpretScopedWithH @'[AtomicState s] withResource \ lock -> \case
-- > MState f ->
-- > bracket_ (embed (takeMVar lock)) (embed (tryPutMVar lock ())) do
-- > s0 <- atomicGet
-- > res <- runTSimple (f s0)
-- > Inspector ins <- getInspectorT
-- > for_ (ins res) \ (s, _) -> atomicPut s
-- > pure (snd <$> res)
-- > MRead ->
-- > liftT atomicGet
interpretScopedWithH ::
∀ extra resource param effect r r1 .
(KnownList extra, r1 ~ Append extra r) =>
(∀ x . param -> (resource -> Sem r1 x) -> Sem r x) ->
(∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r1 x) ->
InterpreterFor (Scoped param resource effect) r
interpretScopedWithH withResource scopedHandler =
interpretWeaving \case
Weaving (InScope param main) s wv ex _ ->
ex <$> withResource param \ resource -> inScope $
restack
(injectMembership
(singList @'[Scoped param resource effect])
(singList @extra)) $ wv (main resource <$ s)
_ ->
errorWithoutStackTrace "top level Run"
where
inScope :: InterpreterFor (Scoped param resource effect) r1
inScope =
interpretWeaving \case
Weaving (InScope param main) s wv ex _ ->
restack (extendMembershipLeft (singList @extra))
(ex <$> withResource param \resource ->
inScope (wv (main resource <$ s)))
Weaving (Run resource act) s wv ex ins ->
ex <$> runTactics s (raise . inScope . wv) ins (inScope . wv)
(scopedHandler resource act)
{-# inline interpretScopedWithH #-}
-- | First-order variant of 'interpretScopedWithH'.
--
-- /Note/: It is necessary to specify the list of local interpreters with a type
-- application; GHC won't be able to figure them out from the type of
-- @withResource@:
--
-- > data SomeAction :: Effect where
-- > SomeAction :: SomeAction m ()
-- >
-- > foo :: InterpreterFor (Scoped () () SomeAction) r
-- > foo =
-- > interpretScopedWith @[Reader Int, State Bool] localEffects \ () -> \case
-- > SomeAction -> put . (> 0) =<< ask @Int
-- > where
-- > localEffects () use = evalState False (runReader 5 (use ()))
interpretScopedWith ::
∀ extra param resource effect r r1 .
(r1 ~ Append extra r, KnownList extra) =>
(∀ x . param -> (resource -> Sem r1 x) -> Sem r x) ->
(∀ m x . resource -> effect m x -> Sem r1 x) ->
InterpreterFor (Scoped param resource effect) r
interpretScopedWith withResource scopedHandler =
interpretScopedWithH @extra withResource \ r e -> liftT (scopedHandler r e)
{-# inline interpretScopedWith #-}
-- | Variant of 'interpretScopedWith' in which no resource is used and the
-- resource allocator is a plain interpreter.
-- This is useful for scopes that only need local effects, but no resources in
-- the handler.
--
-- See the /Note/ on 'interpretScopedWithH'.
interpretScopedWith_ ::
∀ extra param effect r r1 .
(r1 ~ Append extra r, KnownList extra) =>
(∀ x . param -> Sem r1 x -> Sem r x) ->
(∀ m x . effect m x -> Sem r1 x) ->
InterpreterFor (Scoped param () effect) r
interpretScopedWith_ withResource scopedHandler =
interpretScopedWithH @extra (\ p f -> withResource p (f ())) \ () e -> liftT (scopedHandler e)
{-# inline interpretScopedWith_ #-}
-- | Variant of 'interpretScoped' that uses another interpreter instead of a
-- handler.
--
-- This is mostly useful if you want to reuse an interpreter that you cannot
-- easily rewrite (like from another library). If you have full control over the
-- implementation, 'interpretScoped' should be preferred.
--
-- /Note/: The wrapped interpreter will be executed fully, including the
-- initializing code surrounding its handler, for each action in the program, so
-- if the interpreter allocates any resources, they will be scoped to a single
-- action. Move them to @withResource@ instead.
--
-- For example, consider the following interpreter for
-- 'Polysemy.AtomicState.AtomicState':
--
-- > atomicTVar :: Member (Embed IO) r => a -> InterpreterFor (AtomicState a) r
-- > atomicTVar initial sem = do
-- > tv <- embed (newTVarIO initial)
-- > runAtomicStateTVar tv sem
--
-- If this interpreter were used for a scoped version of @AtomicState@ like
-- this:
--
-- > runScoped (\ initial use -> use initial) \ initial -> atomicTVar initial
--
-- Then the @TVar@ would be created every time an @AtomicState@ action is run,
-- not just when entering the scope.
--
-- The proper way to implement this would be to rewrite the resource allocation:
--
-- > runScoped (\ initial use -> use =<< embed (newTVarIO initial)) runAtomicStateTVar
runScoped ::
∀ param resource effect r .
(∀ x . param -> (resource -> Sem r x) -> Sem r x) ->
(resource -> InterpreterFor effect r) ->
InterpreterFor (Scoped param resource effect) r
runScoped withResource scopedInterpreter =
go
where
go :: InterpreterFor (Scoped param resource effect) r
go =
interpretWeaving \ (Weaving effect s wv ex ins) -> case effect of
Run resource act ->
scopedInterpreter resource
$ liftSem $ injWeaving $ Weaving act s (raise . go . wv) ex ins
InScope param main ->
withResource param \ resource -> ex <$> go (wv (main resource <$ s))
{-# inline runScoped #-}
-- | Variant of 'runScoped' in which the resource allocator returns the resource
-- rather tnen calling a continuation.
runScopedAs ::
∀ param resource effect r .
(param -> Sem r resource) ->
(resource -> InterpreterFor effect r) ->
InterpreterFor (Scoped param resource effect) r
runScopedAs resource = runScoped \ p use -> use =<< resource p
{-# inline runScopedAs #-}

2
stack.yaml
View File

@ -1,4 +1,4 @@
resolver: lts-16.31
resolver: lts-19.23
packages:
- .