Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

No more strategy #239

Closed
wants to merge 6 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion polysemy.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: 7ce7e4fdc1a3ebff15b38a550ed247a4ad04bb4c383ad4440212926b3eeea93c
-- hash: ae77b04f8dcc2acf56aec6d5adc81f66dd8126e26910e8891a42ff1b1d992fb4

name: polysemy
version: 1.2.1.0
Expand Down Expand Up @@ -48,6 +48,7 @@ library
Polysemy.Fail
Polysemy.Fail.Type
Polysemy.Final
Polysemy.Final.Type
Polysemy.Fixpoint
Polysemy.Input
Polysemy.Internal
Expand Down
4 changes: 2 additions & 2 deletions src/Polysemy/Async.hs
Original file line number Diff line number Diff line change
Expand Up @@ -92,8 +92,8 @@ asyncToIOFinal :: Member (Final IO) r
-> Sem r a
asyncToIOFinal = interpretFinal $ \case
Async m -> do
ins <- getInspectorS
m' <- runS m
ins <- getInspectorT
m' <- runT m
liftS $ A.async (inspect ins <$> m')
Await a -> liftS (A.wait a)
{-# INLINE asyncToIOFinal #-}
Expand Down
16 changes: 8 additions & 8 deletions src/Polysemy/Error.hs
Original file line number Diff line number Diff line change
Expand Up @@ -148,9 +148,9 @@ errorToIOFinal
=> Sem (Error e ': r) a
-> Sem r (Either e a)
errorToIOFinal sem = withStrategicToFinal @IO $ do
m' <- runS (runErrorAsExcFinal sem)
s <- getInitialStateS
pure $
m' <- runT (runErrorAsExcFinal sem)
s <- getInitialStateT
embed $
either
((<$ s) . Left . unwrapExc)
(fmap Right)
Expand All @@ -165,12 +165,12 @@ runErrorAsExcFinal
=> Sem (Error e ': r) a
-> Sem r a
runErrorAsExcFinal = interpretFinal $ \case
Throw e -> pure $ X.throwIO $ WrappedExc e
Throw e -> embed $ X.throwIO $ WrappedExc e
Catch m h -> do
m' <- runS m
h' <- bindS h
s <- getInitialStateS
pure $ X.catch m' $ \(se :: WrappedExc e) ->
m' <- runT m
h' <- bindT h
s <- getInitialStateT
embed $ X.catch m' $ \(se :: WrappedExc e) ->
h' (unwrapExc se <$ s)
{-# INLINE runErrorAsExcFinal #-}

Expand Down
75 changes: 6 additions & 69 deletions src/Polysemy/Final.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ module Polysemy.Final
-- effects are threaded down to the final monad.
--
-- Much like @Tactics@, computations can be run and threaded
-- through the use of 'runS' and 'bindS', and first-order constructors
-- through the use of 'runT' and 'bindT', and first-order constructors
-- may use 'pureS'. In addition, 'liftS' may be used to
-- lift actions of the final monad.
--
Expand All @@ -28,12 +28,7 @@ module Polysemy.Final
-- with the functorial state wrapped inside of it.
, Strategic
, WithStrategy
, pureS
, liftS
, runS
, bindS
, getInspectorS
, getInitialStateS

-- * Interpretations
, runFinal
Expand All @@ -43,72 +38,14 @@ module Polysemy.Final
, embedToFinal
) where

import Polysemy.Final.Type

import Polysemy.Internal
import Polysemy.Internal.Combinators
import Polysemy.Internal.Union
import Polysemy.Internal.Strategy
import Polysemy.Internal.TH.Effect

-----------------------------------------------------------------------------
-- | This represents a function which produces
-- an action of the final monad @m@ given:
--
-- * The initial effectful state at the moment the action
-- is to be executed.
--
-- * A way to convert @z@ (which is typically @'Sem' r@) to @m@ by
-- threading the effectful state through.
--
-- * An inspector that is able to view some value within the
-- effectful state if the effectful state contains any values.
--
-- A @'Polysemy.Internal.Union.Weaving'@ provides these components,
-- hence the name 'ThroughWeavingToFinal'.
--
-- @since 1.2.0.0
type ThroughWeavingToFinal m z a =
forall f
. Functor f
=> f ()
-> (forall x. f (z x) -> m (f x))
-> (forall x. f x -> Maybe x)
-> m (f a)

-----------------------------------------------------------------------------
-- | An effect for embedding higher-order actions in the final target monad
-- of the effect stack.
--
-- This is very useful for writing interpreters that interpret higher-order
-- effects in terms of the final monad.
--
-- 'Final' is more powerful than 'Embed', but is also less flexible
-- to interpret (compare 'Polysemy.Embed.runEmbedded' with 'finalToFinal').
-- If you only need the power of 'embed', then you should use 'Embed' instead.
--
-- /Beware/: 'Final' actions are interpreted as actions of the final monad,
-- and the effectful state visible to
-- 'withWeavingToFinal' \/ 'withStrategicToFinal'
-- \/ 'interpretFinal'
-- is that of /all interpreters run in order to produce the final monad/.
--
-- This means that any interpreter built using 'Final' will /not/
-- respect local/global state semantics based on the order of
-- interpreters run. You should signal interpreters that make use of
-- 'Final' by adding a @-'Final'@ suffix to the names of these.
--
-- State semantics of effects that are /not/
-- interpreted in terms of the final monad will always
-- appear local to effects that are interpreted in terms of the final monad.
--
-- State semantics between effects that are interpreted in terms of the final monad
-- depend on the final monad. For example, if the final monad is a monad transformer
-- stack, then state semantics will depend on the order monad transformers are stacked.
--
-- @since 1.2.0.0
newtype Final m z a where
WithWeavingToFinal
:: ThroughWeavingToFinal m z a
-> Final m z a

makeSem_ ''Final

Expand Down Expand Up @@ -146,13 +83,13 @@ embedFinal m = withWeavingToFinal $ \s _ _ -> (<$ s) <$> m
-- | Allows for embedding higher-order actions of the final monad
-- by providing the means of explicitly threading effects through @'Sem' r@
-- to the final monad. This is done through the use of the 'Strategic'
-- environment, which provides 'runS' and 'bindS'.
-- environment, which provides 'runT' and 'bindT'.
--
-- You are discouraged from using 'withStrategicToFinal' in application code,
-- as it ties your application code directly to the final monad.
--
-- @since 1.2.0.0
withStrategicToFinal :: Member (Final m) r
withStrategicToFinal :: (Member (Final m) r, Monad m)
=> Strategic m (Sem r) a
-> Sem r a
withStrategicToFinal strat = withWeavingToFinal (runStrategy strat)
Expand Down Expand Up @@ -181,7 +118,7 @@ withStrategicToFinal strat = withWeavingToFinal (runStrategy strat)
-- @since 1.2.0.0
interpretFinal
:: forall m e r a
. Member (Final m) r
. (Member (Final m) r, Monad m)
=> (forall x n. e n x -> Strategic m n x)
-- ^ A natural transformation from the handled effect to the final monad.
-> Sem (e ': r) a
Expand Down
62 changes: 62 additions & 0 deletions src/Polysemy/Final/Type.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,62 @@
module Polysemy.Final.Type where

-----------------------------------------------------------------------------
-- | An effect for embedding higher-order actions in the final target monad
-- of the effect stack.
--
-- This is very useful for writing interpreters that interpret higher-order
-- effects in terms of the final monad.
--
-- 'Final' is more powerful than 'Embed', but is also less flexible
-- to interpret (compare 'Polysemy.Embed.runEmbedded' with 'finalToFinal').
-- If you only need the power of 'embed', then you should use 'Embed' instead.
--
-- /Beware/: 'Final' actions are interpreted as actions of the final monad,
-- and the effectful state visible to
-- 'withWeavingToFinal' \/ 'withStrategicToFinal'
-- \/ 'interpretFinal'
-- is that of /all interpreters run in order to produce the final monad/.
--
-- This means that any interpreter built using 'Final' will /not/
-- respect local/global state semantics based on the order of
-- interpreters run. You should signal interpreters that make use of
-- 'Final' by adding a @-'Final'@ suffix to the names of these.
--
-- State semantics of effects that are /not/
-- interpreted in terms of the final monad will always
-- appear local to effects that are interpreted in terms of the final monad.
--
-- State semantics between effects that are interpreted in terms of the final monad
-- depend on the final monad. For example, if the final monad is a monad transformer
-- stack, then state semantics will depend on the order monad transformers are stacked.
--
-- @since 1.2.0.0
newtype Final m z a where
WithWeavingToFinal
:: ThroughWeavingToFinal m z a
-> Final m z a

-----------------------------------------------------------------------------
-- | This represents a function which produces
-- an action of the final monad @m@ given:
--
-- * The initial effectful state at the moment the action
-- is to be executed.
--
-- * A way to convert @z@ (which is typically @'Sem' r@) to @m@ by
-- threading the effectful state through.
--
-- * An inspector that is able to view some value within the
-- effectful state if the effectful state contains any values.
--
-- A @'Polysemy.Internal.Union.Weaving'@ provides these components,
-- hence the name 'ThroughWeavingToFinal'.
--
-- @since 1.2.0.0
type ThroughWeavingToFinal m z a =
forall f
. Functor f
=> f ()
-> (forall x. f (z x) -> m (f x))
-> (forall x. f x -> Maybe x)
-> m (f a)
11 changes: 6 additions & 5 deletions src/Polysemy/Fixpoint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -66,10 +66,10 @@ fixpointToFinal :: forall m r a
-> Sem r a
fixpointToFinal = interpretFinal @m $
\(Fixpoint f) -> do
f' <- bindS f
s <- getInitialStateS
ins <- getInspectorS
pure $ mfix $ \fa -> f' $
f' <- bindT f
s <- getInitialStateT
ins <- getInspectorT
embed $ mfix $ \fa -> f' $
fromMaybe (bomb "fixpointToFinal") (inspect ins fa) <$ s
{-# INLINE fixpointToFinal #-}

Expand Down Expand Up @@ -99,7 +99,8 @@ runFixpoint lower = interpretH $ \case
--
-- __Note__: 'runFixpointM' is subject to the same caveats as 'fixpointToFinal'.
runFixpointM
:: ( MonadFix m
:: forall m r a
. ( MonadFix m
, Member (Embed m) r
)
=> (∀ x. Sem r x -> m x)
Expand Down
Loading